home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / rexx / imc / rexx-imc.5 / rxfn.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-06-25  |  74.8 KB  |  3,094 lines
  1. /* The builtin functions of REXX/imc         (C) Ian Collier 1992 */
  2.  
  3. #include"functions.h"
  4. #include"globals.h"
  5. #include<string.h>
  6. #include<time.h>
  7. #include<sys/ioctl.h>
  8. #include<sgtty.h>
  9. #include<sys/param.h>
  10. #include<malloc.h>
  11. #include<memory.h>
  12. #include<pwd.h>
  13. #include<search.h>
  14. #include<fcntl.h>
  15. #include<unistd.h>
  16. #include<errno.h>
  17. #include<sys/stat.h>
  18. #include<stdlib.h>
  19. #ifdef HAS_TTYCOM
  20. #include<sys/ttycom.h>
  21. #endif
  22. #define STDIN 0
  23. void rxsource();
  24. void rxerror();
  25. void rxlength();
  26. void rxtime();
  27. void rxdate();
  28. void rxleft();
  29. void rxright();
  30. void rxstrip();
  31. void rxvalue();
  32. void rxdatatype();
  33. void rxcopies();
  34. void rxspace();
  35. void rxrange();
  36. void c2x(),c2d(),b2x(),b2d(),d2c(),d2b(),d2x(),x2c(),x2d(),x2b();
  37. void xbyte();
  38. void rxsystem();
  39. void rxpos();
  40. void rxlastpos();
  41. void rxcentre();
  42. void rxjustify();
  43. void rxsubstr();
  44. void rxarg();
  45. void rxabbrev();
  46. void rxabs();
  47. void rxcompare();
  48. void rxdelstr();
  49. void rxdelword();
  50. void rxinsert();
  51. void rxmax();
  52. void rxmin();
  53. void rxoverlay();
  54. void rxrandom();
  55. void rxreverse();
  56. void rxsign();
  57. void rxsubword();
  58. void rxsymbol();
  59. void rxlate();
  60. void rxtrunc();
  61. void rxverify();
  62. void rxword();
  63. void rxwordindex();
  64. void rxwordlength();
  65. void rxwordpos();
  66. void rxwords();
  67. void rxdigits();
  68. void rxfuzz();
  69. void rxtrace();
  70. void rxform();
  71. void rxformat();
  72. void rxqueued();
  73. void rxlinesize();
  74. void rxbitand();
  75. void rxbitor();
  76. void rxbitxor();
  77. void rxuserid();
  78. void rxgetcwd();
  79. void rxchdir();
  80. void rxgetenv();
  81. void rxputenv();
  82. void rxopen();
  83. void rxlinein();
  84. void rxlineout();
  85. void rxcharin();
  86. void rxcharout();
  87. void rxchars();
  88. void rxlines();
  89. void rxchars2();
  90. void rxclose();
  91. void rxfileno();
  92. void rxfdopen();
  93. void rxpopen();
  94. void rxpclose();
  95. void rxftell();
  96. void rxstream();
  97. void rxaddress();
  98. void rxcondition();
  99.  
  100. char *bsearch();
  101. int compar();
  102.  
  103. void binrel(); /* The calculator routine which implements binary relations */
  104.  
  105. struct fnlist {char *name;void (*fn)();};
  106.  
  107. int rxfn(name,argc)   /* does function if possible; returns 1 if successful */
  108.                       /* Returns -1 if the name was recognised as a math    */
  109.               /* function, and 0 if the name was unrecognised.      */
  110. char *name;           /* Name of the function to call */
  111. int argc;             /* Number of arguments passed to it */
  112. {
  113.    static struct fnlist names[]={   /* The name and address of ever builtin */
  114.       "ABBREV",     rxabbrev,       /* function, in alphabetical order      */
  115.       "ABS",        rxabs,
  116.       "ADDRESS",    rxaddress,
  117.       "ARG",        rxarg,
  118.       "B2D",        b2d,
  119.       "B2X",        b2x,
  120.       "BITAND",     rxbitand,
  121.       "BITOR",      rxbitor,
  122.       "BITXOR",     rxbitxor,
  123.       "C2D",        c2d,
  124.       "C2X",        c2x,
  125.       "CENTER",     rxcentre,
  126.       "CENTRE",     rxcentre,
  127.       "CHARIN",     rxcharin,
  128.       "CHAROUT",    rxcharout,
  129.       "CHARS",      rxchars,
  130.       "CHDIR",      rxchdir,
  131.       "CLOSE",      rxclose,
  132.       "COMPARE",    rxcompare,
  133.       "CONDITION",  rxcondition,
  134.       "COPIES",     rxcopies,
  135.       "D2B",        d2b,
  136.       "D2C",        d2c,
  137.       "D2X",        d2x,
  138.       "DATATYPE",   rxdatatype,
  139.       "DATE",       rxdate,
  140.       "DELSTR",     rxdelstr,
  141.       "DELWORD",    rxdelword,
  142.       "DIGITS",     rxdigits,
  143.       "ERRORTEXT",  rxerror,
  144.       "FDOPEN",     rxfdopen,
  145.       "FILENO",     rxfileno,
  146.       "FORM",       rxform,
  147.       "FORMAT",     rxformat,
  148.       "FTELL",      rxftell,
  149.       "FUZZ",       rxfuzz,
  150.       "GETCWD",     rxgetcwd,
  151.       "GETENV",     rxgetenv,
  152.       "INSERT",     rxinsert,
  153.       "JUSTIFY",    rxjustify,
  154.       "LASTPOS",    rxlastpos,
  155.       "LEFT",       rxleft,
  156.       "LENGTH",     rxlength,
  157.       "LINEIN",     rxlinein,
  158.       "LINEOUT",    rxlineout,
  159.       "LINES",      rxlines,
  160.       "LINESIZE",   rxlinesize,
  161.       "MAX",        rxmax,
  162.       "MIN",        rxmin,
  163.       "OPEN",       rxopen,
  164.       "OVERLAY",    rxoverlay,
  165.       "PCLOSE",     rxpclose,
  166.       "POPEN",      rxpopen,
  167.       "POS",        rxpos,
  168.       "PUTENV",     rxputenv,
  169.       "QUEUED",     rxqueued,
  170.       "RANDOM",     rxrandom,
  171.       "REVERSE",    rxreverse,
  172.       "RIGHT",      rxright,
  173.       "SIGN",       rxsign,
  174.       "SOURCELINE", rxsource,
  175.       "SPACE",      rxspace,
  176.       "STREAM",     rxstream,
  177.       "STRIP",      rxstrip,
  178.       "SUBSTR",     rxsubstr,
  179.       "SUBWORD",    rxsubword,
  180.       "SYMBOL",     rxsymbol,
  181.       "SYSTEM",     rxsystem,
  182.       "TIME",       rxtime,
  183.       "TRACE",      rxtrace,
  184.       "TRANSLATE",  rxlate,
  185.       "TRUNC",      rxtrunc,
  186.       "USERID",     rxuserid,
  187.       "VALUE",      rxvalue,
  188.       "VERIFY",     rxverify,
  189.       "WORD",       rxword,
  190.       "WORDINDEX",  rxwordindex,
  191.       "WORDLENGTH", rxwordlength,
  192.       "WORDPOS",    rxwordpos,
  193.       "WORDS",      rxwords,
  194.       "X2B",        x2b,
  195.       "X2C",        x2c,
  196.       "X2D",        x2d,
  197.       "XRANGE",     rxrange
  198.       };
  199. #define nofun 0     /* "nofun" means "this function ain't here" */
  200.  
  201. /* The following structure names all the recognised mathematical functions;
  202.    if a function is found here then it is loaded from the external math
  203.    package. */
  204. static struct fnlist rxmathfn[]={"ACOS",nofun,"ASIN",nofun,"ATAN",nofun,
  205.            "COS",nofun,"EXP",nofun,"LN",nofun,"SIN",nofun,"SQRT",nofun,
  206.            "TAN",nofun,"TOPOWER",nofun};
  207.        
  208. #define numfun 84  /* The number of builtin functions */
  209. #define nummath 10 /* The number of math functions */
  210.  
  211.    struct fnlist test;
  212.    struct fnlist *ptr;
  213.    test.name=name; /* Initialise a structure with the candidate name */
  214.    ptr=(struct fnlist *) /* Search for a builtin function */
  215.       bsearch((char*)&test,(char*)names,numfun,sizeof(struct fnlist),compar);
  216.    if(!ptr){ /* If not found, search for a math function */
  217.       if(bsearch((char*)&test,(char*)rxmathfn,nummath,sizeof(struct fnlist),compar))
  218.          return -1; /* math function recognised */
  219.       return 0;     /* no function recognised */
  220.    }
  221.    (*(ptr->fn))(argc);  /* Call the builtin function */
  222.    return 1;            /* Done. */
  223. }
  224.  
  225. int compar(s1,s2) /* Compares two items of a function list, */
  226. char *s1,*s2;     /* as required by bsearch()               */
  227. {
  228.    return strcmp(((struct fnlist*)s1)->name,((struct fnlist *)s2)->name);
  229. }
  230.  
  231. char *undelete(l) /* A utility function like delete(l) except that */
  232. int *l;           /* the value isn't deleted from the stack */
  233. {
  234.    char *ptr=cstackptr+ecstackptr-four;
  235.    (*l)= *(int *)ptr;
  236.    if(*l>=0)ptr-=align(*l);
  237.    else ptr=(char *)-1;/* I don't think this is ever used */
  238.    return ptr;
  239. }
  240.  
  241. /* The rest of this file contains the builtin functions listed in the
  242.    dictionary above.  In general, each function ABC() is implemented by
  243.    the C routine rxabc().  Each routine takes one parameter - namely
  244.    the number of arguments passed to the builtin function - and gives no
  245.    return value.  The arguments and result of the builtin function are
  246.    passed on the calculator stack.  A null argument (as in abc(x,,y))
  247.    is represented by a stacked value having length -1. */
  248.  
  249. void rxsource(argc) /* souceline() function */
  250. int argc;
  251. {
  252.    int i;
  253.    char *s;
  254.    if(!argc){
  255.       stackint(lines); /* the number of source lines */
  256.       return;
  257.    }
  258.    if(argc!=1)die(Ecall);
  259.    if((i=getint(1))>lines||i<1)die(Erange);
  260.    s=source[i];
  261.    stack(s,strlen(s)); /* the ith source line */
  262. }
  263.  
  264. void rxerror(argc)  /* errortext() function */
  265. int argc;
  266. {
  267.    char *msg;
  268.    if(argc!=1)die(Ecall);
  269.    msg=message(getint(1));
  270.    stack(msg,strlen(msg));
  271. }
  272. void rxlength(argc)
  273. int argc;
  274. {
  275.    int l;
  276.    if(argc!=1)die(Ecall);
  277.    delete(&l);
  278.    stackint(l);
  279. }
  280. void rxtime(argc)
  281. int argc;
  282. {
  283.    struct tm *t2;
  284.    struct timezone tz;
  285.    char ans[20];
  286.    char opt='N';
  287.    char *arg;
  288.    long e1;
  289.    long e2;
  290.    int l;
  291.    if(!(timeflag&2))
  292.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  293.    timeflag|=2;
  294.    t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  295.    if(argc>1)die(Ecall);
  296.    if(argc==1){
  297.       arg=delete(&l);
  298.       if(!l)die(Ecall);
  299.       opt=arg[0]&0xdf;
  300.    }
  301.    switch(opt){
  302.       case 'C':l=t2->tm_hour%12;
  303.          if(l==0)l=12;
  304.          sprintf(ans,"%d:%02d%s",l,t2->tm_min,(t2->tm_hour <12)?"am":"pm");
  305.          break;
  306.       case 'N':sprintf(ans,"%02d:%02d:%02d",t2->tm_hour,t2->tm_min,t2->tm_sec);
  307.          break;
  308.       case 'L':sprintf(ans,"%02d:%02d:%02d.%06d",t2->tm_hour,t2->tm_min,
  309.                        t2->tm_sec,timestamp.tv_usec);
  310.          break;
  311.       case 'H':sprintf(ans,"%d",t2->tm_hour);
  312.          break;
  313.       case 'M':sprintf(ans,"%d",(t2->tm_hour)*60+(t2->tm_min));
  314.          break;
  315.       case 'S':sprintf(ans,"%d",((t2->tm_hour)*60+(t2->tm_min))*60+(t2->tm_sec));
  316.          break;
  317.       case 'E':
  318.       case 'R':if(!(timeflag&1))secs=timestamp.tv_sec,
  319.                                 microsecs=timestamp.tv_usec;
  320.          timeflag|=1,
  321.          e2=timestamp.tv_usec-microsecs,
  322.          e1=timestamp.tv_sec-secs;
  323.          if(e2<0)e2+=1000000,e1--;
  324.          if(opt=='R')secs=timestamp.tv_sec,microsecs=timestamp.tv_usec;
  325.          if(e1||e2)sprintf(ans,"%ld.%06d",e1,e2);
  326.      else ans[0]='0',ans[1]=0; /* "0", not "0.000000" */
  327.          break;
  328.       default:die(Ecall);
  329.    }
  330.    stack(ans,strlen(ans));
  331. }
  332.  
  333. char *month[12]={"Jan","Feb","Mar","Apr","May","Jun","Jul",
  334.                  "Aug","Sep","Oct","Nov","Dec"};
  335. /* month names originally for rxdate() but needed for the Rexx version string*/
  336.  
  337. void rxdate(argc)
  338. int argc;
  339. {
  340.    static char *wkday[7]={"Sunday","Monday","Tuesday","Wednesday",
  341.                           "Thursday","Friday","Saturday"};
  342.    static char *fullmonth[12]={"January","February","March","April","May",
  343.                           "June","July","August","September","October",
  344.               "November","December"};
  345.    struct timezone tz;   
  346.    struct tm *t2;
  347.    char ans[20];
  348.    char opt='N';
  349.    char *arg;
  350.    int l;
  351.    if(!(timeflag&2))
  352.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  353.    timeflag|=2;
  354.    t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  355.    if(argc>1)die(Ecall);
  356.    if(argc==1){
  357.       arg=delete(&l);
  358.       if(!l)die(Ecall);
  359.       opt=arg[0]&0xdf;
  360.    }
  361.    switch(opt){
  362.       case 'B':sprintf(ans,"%ld",timestamp.tv_sec/86400+719162L);
  363.          break;
  364.       case 'C':sprintf(ans,"%ld",timestamp.tv_sec/86400+25568L);
  365.          break;
  366.       case 'D':sprintf(ans,"%d",t2 -> tm_yday+1);
  367.          break;
  368.       case 'E':sprintf(ans,"%02d/%02d/%02d",t2 ->tm_mday,t2->tm_mon+1,t2->tm_year);
  369.          break;
  370.       case 'J':sprintf(ans,"%02d%03d",t2->tm_year,t2->tm_yday+1);
  371.          break;
  372.       case 'M':strcpy(ans,fullmonth[t2->tm_mon]);
  373.          break;
  374.       case 'N':sprintf(ans,"%d %s %d",t2->tm_mday,month[t2->tm_mon],t2->tm_year+1900);
  375.          break;
  376.       case 'O':sprintf(ans,"%02d/%02d/%02d",t2->tm_year,t2->tm_mon+1,t2->tm_mday);
  377.          break;
  378.       case 'S':sprintf(ans,"%04d%02d%02d",t2->tm_year+1900,t2->tm_mon+1,t2->tm_mday);
  379.          break;
  380.       case 'U':sprintf(ans,"%02d/%02d/%02d",t2->tm_mon+1,t2->tm_mday,t2->tm_year);
  381.          break;
  382.       case 'W':strcpy(ans,wkday[t2->tm_wday]);
  383.          break;
  384.       default:die(Ecall);
  385.    }
  386.    stack(ans,strlen(ans));
  387. }
  388. void rxstrip(argc)
  389. int argc;
  390. {
  391.    char *arg;
  392.    int len;
  393.    char strip=' ';
  394.    int flg=0;
  395.    if(argc>3||!argc)die(Ecall);
  396.    if(argc==3){
  397.       arg=delete(&len);
  398.       if(len>1||len==0)die(Ecall);
  399.       else if(len==1)strip=arg[0];
  400.    }
  401.    if(argc>1){
  402.       arg=delete(&len);
  403.       if(!len)die(Ecall);
  404.       else if(len>0)switch(arg[0]&0xdf){
  405.       case 'T':flg=1;
  406.          break;
  407.       case 'L':flg= -1;
  408.       case 'B':break;
  409.       default:die(Ecall);
  410.       }
  411.    }
  412.    arg=delete(&len);
  413.    if(len<0)die(Enoarg);
  414.    if(flg<=0)for(;arg[0]==strip&&len;arg++,len--); /* strip leading chars */
  415.    if(flg>=0){while(len--&&arg[len]==strip);len++;}/* strip trailing chars */
  416.    mtest(workptr,worklen,len+5,len+5); /* move to worksp before stacking, */
  417.    memcpy(workptr,arg,len);            /* as stack() will destroy this copy */
  418.    stack(workptr,len);
  419. }
  420. void rxleft(argc)
  421. int argc;
  422. {
  423.    char *arg;
  424.    int len;
  425.    int len1;
  426.    char pad=' ';
  427.    int num;
  428.    if(argc>3||argc<2)die(Ecall);
  429.    if(argc==3){
  430.       arg=delete(&len);
  431.       if(len>=0){
  432.          if(len!=1)die(Ecall);
  433.          pad=arg[0];
  434.       }
  435.    }
  436.    if((num=getint(1))<0)die(Ecall);
  437.    arg=delete(&len);
  438.    if(len<0)die(Enoarg);
  439.    len1=len>num?len:num;
  440.    mtest(workptr,worklen,len1+5,len1+5);
  441.    len1=len<num?len:num;
  442.    memcpy(workptr,arg,len1);
  443.    for(;len1<num;workptr[len1++]=pad);
  444.    stack(workptr,num);
  445. }
  446. void rxright(argc)
  447. int argc;
  448. {
  449.    char *arg;
  450.    int len;
  451.    int len1;
  452.    int i;
  453.    char pad=' ';
  454.    int num;
  455.    if(argc>3||argc<2)die(Ecall);
  456.    if(argc==3){
  457.       arg=delete(&len);
  458.       if(len>0){
  459.          if(len!=1)die(Ecall);
  460.          pad=arg[0];
  461.       }
  462.    }
  463.    if((num=getint(1))<0)die(Ecall);
  464.    arg=delete(&len);
  465.    if(len<0)die(Enoarg);
  466.    len1=len>num?len:num;
  467.    mtest(workptr,worklen,len1+5,len1+5);
  468.    for(i=0;len+i<num;workptr[i++]=pad);
  469.    len1=len<num?len:num;
  470.    memcpy(workptr+i,arg+len-len1,len1);
  471.    stack(workptr,num);
  472. }
  473.  
  474. char *rxgetname(nl,t) /* get a symbol (if compound symbol, substitute values
  475.                          in tail). Afterwards, t=1 if valid, t=0 otherwise. */
  476. int *nl,*t;           /* Return value is the name, nl is the length.  The   */
  477. {                     /* result may contain garbage if the symbol was bad.  */
  478.    static char name[maxvarname];
  479.    int len,l;
  480.    char *arg=delete(&len);
  481.    char *val;
  482.    int p;
  483.    int i=0;
  484.    char c;
  485.    int dot=0;
  486.    int constsym=rexxsymbol(arg[0])<=0; /* whether it is a constant symbol */
  487.    (*t)=1;
  488.    if(len>=maxvarname-1)return *t=0,name;
  489.    while(len&&arg[0]!='.') {        /* Get the stem part */
  490.       name[i++]=c=uc((arg++)[0]),
  491.       len--;
  492.       if(!rexxsymbol(c))return *t=0,name;
  493.    }
  494.    if(len==1&&arg[0]=='.')dot=1,len--; /* Delete final dot of a stem */
  495.    while(len&&arg[0]=='.'){         /* Get each element of the tail */
  496.       dot=1;
  497.       name[p= i++]='.',
  498.       ++p,
  499.       ++arg,
  500.       len--;
  501.       while(len&&arg[0]!='.'){      /* copy the element */
  502.          c=name[i++]=uc((arg++)[0]),len--;
  503.          if(!rexxsymbol(c))return *t=0,name;
  504.       }
  505.       if(p!=i&&!constsym){          /* substitute it */
  506.          name[i]=0;
  507.          if(val=varget(name+p,i-p,&l)){
  508.             if(len+l>=maxvarname-1)return *t=0,name;
  509.             memcpy(name+p,val,l),i=p+l;
  510.          }
  511.       }
  512.    }
  513.    (*nl)=i;
  514.    name[i]=0;
  515.    if(dot&&!constsym)name[0]|=128; /* Compound symbols have the MSB set */
  516.    return name;
  517. }
  518.       
  519. void rxvalue(argc)
  520. int argc;
  521. {
  522.    char *arg;
  523.    char *val;
  524.    char *pool=0;
  525.    char **entry;
  526.    int poollen;
  527.    char *new=0;
  528.    int newlen;
  529.    int l,len,t;
  530.    int oldlen;
  531.    int path;
  532.    if(argc==3){
  533.       pool=delete(&poollen);
  534.       argc--;
  535.       pool[poollen]=0;
  536.    }
  537.    if(argc==2){
  538.       new=delete(&newlen);
  539.       argc--;
  540.       if(newlen<0)new=0;
  541.    }
  542.    if(argc!=1)die(Ecall);
  543.    arg=rxgetname(&len,&t); /* Get the symbol name, then try to get its value */
  544.    if(pool)                /* The pool name determines what we do here */
  545.       if(!strcasecmp(pool,"ENVIRONMENT")){
  546.          if(memchr(arg,0,len))die(Ecall);
  547.      arg[len]=0;
  548.      if(val=getenv(arg))stack(val,strlen(val));
  549.      else stack(cnull,0);
  550.      if(!new)return;
  551.      if(memchr(new,0,newlen))die(Ecall);
  552.      path=strcmp(arg,"PATH");
  553.      entry=(char**)hashfind(0,arg,&l);
  554.      arg[len]='=';
  555.      arg[len+1]=0;
  556.      putenv(arg); /* release the previous copy from the environment */
  557.      if(!l)*entry=allocm(len+newlen+2);
  558.      else if(strlen(*entry)<len+newlen+2)
  559.         if(!(*entry=realloc(*entry,len+newlen+2)))die(Emem);
  560.      memcpy(*entry,arg,++len);
  561.      memcpy(*entry+len,new,newlen);
  562.      entry[0][len+newlen]=0;
  563.      putenv(*entry);
  564.      if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  565.      return;
  566.       }
  567.       /* here add more "else if"s */
  568.       else if(strcasecmp(pool,"REXX"))die(Ecall);
  569.    if(t&&(val=varget(arg,len,&l)))stack(val,l);
  570.    else if(t!=1)die(Ecall);/* die if it was bad */
  571.    else { /* stack the variable's name */
  572.       oldlen=len;
  573.       if((l=arg[0]&128)&&!memchr(arg,'.',len))arg[len++]='.';
  574.       arg[0]&=127,stack(arg,len);
  575.       arg[0]|=l;
  576.       len=oldlen;
  577.    }
  578.    if(new)varset(arg,len,new,newlen);
  579. }
  580.  
  581. void rxdatatype(argc)
  582. int argc;
  583. {
  584.    char *arg;
  585.    int len;
  586.    int i,numb=1,fst=1;
  587.    int m,e,z,l;
  588.    char c;
  589.    if(argc>2||!argc)die(Ecall);
  590.    if(argc==2&&isnull())delete(&len),argc--;
  591.    if(argc==1){
  592.       if(num(&m,&e,&z,&l)>=0)  /* numeric if true */
  593.          delete(&l),
  594.          stack("NUM",3);
  595.       else delete(&l),stack("CHAR",4);
  596.    }
  597.    else{
  598.       arg=delete(&len);
  599.       if(isnull())die(Enoarg);
  600.       if(len<1)die(Ecall);
  601.       switch(arg[0]&0xdf){ /* Depending on type, set i to the answer */
  602.       case 'A':arg=delete(&len);
  603.          if(!len){i=0;break;}
  604.          i=1;
  605.          while(len--)if((m=alphanum((arg++)[0]))<1||m==3)i=0;
  606.          break;
  607.       case 'B':arg=delete(&len);
  608.          if(!len){i=0;break;}
  609.          i=1;
  610.          while(len--)if((c=(arg++)[0])!='0'&&c!='1')i=0;
  611.          break;
  612.       case 'L':arg=delete(&len);
  613.          if(!len){i=0;break;}
  614.          i=1;
  615.          while(len--)if((c=(arg++)[0])<'a'||c>'z')i=0;
  616.          break;
  617.       case 'M':arg=delete(&len);
  618.          if(!len){i=0;break;}
  619.          i=1;
  620.          while(len--)if((c=(arg++)[0]|0x20)<'a'||c>'z')i=0;
  621.          break;
  622.       case 'N':i=(num(&m,&e,&z,&l)>=0),
  623.          delete(&len);
  624.          break;
  625.       case 'S':arg=delete(&len);
  626.          if(!len){i=0;break;}
  627.          i=1;
  628.          while(len--)if((m=rexxsymboldot((arg++)[0]))==0)i=0;
  629.          break;
  630.       case 'U':arg=delete(&len);
  631.          if(!len){i=0;break;}
  632.          i=1;
  633.          while(len--)if((c=(arg++)[0])<'A'||c>'Z')i=0;
  634.          break;
  635.       case 'W':numb=num(&m,&e,&z,&l),
  636.          i=numb>=0&&(z||isint(numb,l,e)),
  637.          delete(&len);
  638.          break;
  639.       case 'X':arg=delete(&len);
  640.          i=1,l=0;
  641.          while(len&&arg[0]==' ')arg++,len--;
  642.          while(len){
  643.             if(arg[0]==' '){
  644.                if(fst)fst=0;
  645.                else if(l%2)i=0;
  646.                l=0;
  647.                while(len&&arg[0]==' ')arg++,len--;
  648.             }
  649.             if(len==0)break;
  650.             c=(arg++)[0],len--;
  651.             if((c-='0')<0)i=0;
  652.             else if(c>9){
  653.                if((c-=7)<10)i=0;
  654.                if(c>15)if((c-=32)<10)i=0;
  655.                if(c>15)i=0;
  656.             }
  657.             l++;
  658.          }
  659.          if(!fst&&(l%2))i=0;
  660.          break;
  661.       default:die(Ecall);
  662.       }
  663.       stack((c=i+'0',&c),1);
  664.    }
  665. }
  666. void rxcopies(argc)
  667. int argc;
  668. {
  669.    int copies;
  670.    char *arg,*p;
  671.    char *mtest_old;
  672.    long mtest_diff;
  673.    int len;
  674.    int a;
  675.    if(argc!=2)die(Ecall);
  676.    if((copies=getint(1))<0)die(Ecall);
  677.    arg=delete(&len);
  678.    if(len<0)die(Enoarg);
  679.    if(!(len&&copies)){stack(cnull,0);return;}
  680.    if dtest(cstackptr,cstacklen,ecstackptr+len*copies+16,len*copies+16)
  681.       arg+=mtest_diff; /* Make room for the copies, then stack them directly */
  682.    for(a=len*(copies-1),p=arg+len;a--;p++[0]=arg++[0]);
  683.    ecstackptr+=align(len*=copies),
  684.    *(int *)(cstackptr+ecstackptr)=len,
  685.    ecstackptr+=four;
  686. }
  687. void rxspace(argc)
  688. int argc;
  689. {
  690.    char *arg;
  691.    int len;
  692.    int len1,len2;
  693.    char pad=' ';
  694.    int num=1;
  695.    int i;
  696.    if(argc<1||argc>3)die(Ecall);
  697.    if(argc==3){  /* First we find the character to pad with */
  698.       argc--;
  699.       arg=delete(&len);
  700.       if(len>=0){
  701.          if(len!=1)die(Ecall);
  702.          pad=arg[0];
  703.       }
  704.    }
  705.    if(argc==2){ /* Then the number of spaces between each word */
  706.       argc--;
  707.       if(isnull())delete(&len);
  708.       else if((num=getint(1))<0)die(Ecall);
  709.    }
  710.    arg=delete(&len); /* and finally the phrase to operate on */
  711.    if(len<0)die(Enoarg);
  712.    while(len--&&arg[0]==' ')arg++;
  713.    len++;
  714.    while(len--&&arg[len]==' ');
  715.    len++;
  716.    mtest(workptr,worklen,len*(num+1),len*(num+2));
  717.    for(len1=len2=0;len2<len;){ /* Make the result string in the workspace */
  718.       while((workptr[len1++]=arg[len2++])!=' '&&len2<=len);
  719.       while(len2<len&&arg[len2]==' ')len2++;
  720.       for(i=0,len1--;i<num;workptr[len1++]=pad)i++;
  721.    }
  722.    if(len)len1-=num;  /* Remove the padding from after the last word */
  723.    stack(workptr,len1);
  724. }
  725. void rxrange(argc)
  726. int argc;
  727. {
  728.    unsigned int c2=255;
  729.    unsigned int c1=0;
  730.    unsigned char *arg;
  731.    int len;
  732.    if(argc>2)die(Ecall);
  733.    if(argc>1){
  734.       arg=(unsigned char *)delete(&len);
  735.       if(len>=0)
  736.          if(len!=1)die(Ecall);
  737.          else c2=arg[0];
  738.    }
  739.    if(argc){
  740.       arg=(unsigned char *)delete(&len);
  741.       if(len>=0)
  742.          if(len!=1)die(Ecall);
  743.          else c1=arg[0];
  744.    }
  745.    if(c1>c2)c2+=256;
  746.    len=c2-c1+1;
  747.    mtest(cstackptr,cstacklen,ecstackptr+len+16,len+16);
  748.    for(arg=(unsigned char *)(cstackptr+ecstackptr);c1<=c2;(*(arg++))=(c1++)&255);
  749.    *(int *)(cstackptr+(ecstackptr+=align(len)))=len,
  750.    ecstackptr+=four;
  751. }
  752. void c2x(argc)
  753. int argc;
  754. {
  755.    char *arg;
  756.    int len;
  757.    int i;
  758.    if(argc!=1)die(Ecall);
  759.    arg=delete(&len);
  760.    mtest(workptr,worklen,len+len,len+len-worklen);
  761.    for(i=0;i<len;i++)xbyte(workptr+i+i,arg[i]);
  762.    stack(workptr,len+len);
  763. }
  764. void xbyte(where,what) /* Place two hex digits representing "what", "where" */
  765. char *where;
  766. unsigned char what;
  767. {
  768.    unsigned char c1=what>>4;
  769.    what&=15;
  770.    if(what>9)what+=7;
  771.    if(c1>9)c1+=7;
  772.    where[0]=c1+'0',where[1]=what+'0';
  773. }
  774. void c2d(argc)
  775. int argc;
  776. {
  777.    unsigned char *arg;
  778.    int len;
  779.    int n=-1;
  780.    unsigned int num=0;
  781.    unsigned char sign;
  782.    int s=0;
  783.    if(argc==2){
  784.       argc--;
  785.       if((n=getint(1))<0)die(Ecall);
  786.    }
  787.    if(argc!=1)die(Ecall);
  788.    arg=(unsigned char *)delete(&len);
  789.    if(n<0)n=len+1;
  790.    while(n-->0)
  791.       if(len>0){
  792.          num|=(sign=arg[--len])<<s;
  793.      if(sign&&s>=8*four||(int)num<0)die(Ecall);
  794.      s+=8;
  795.       }
  796.       else sign=0;
  797.    sign= -(sign>127);
  798.    while(s<8*four)num|=sign<<s,s+=8;
  799.    stackint((int)num);
  800. }
  801. void b2x(argc)
  802. int argc;
  803. {
  804.    char *arg;
  805.    int len;
  806.    int i,j,k;
  807.    unsigned char d,e;
  808.    if(argc!=1)die(Ecall);
  809.    arg=delete(&len);
  810.    mtest(workptr,worklen,len/8+2,len/8+2-worklen);
  811.    for(i=((len-1)&7)-7,k=0;i<len;i+=8){
  812.       for(d=0,j=i;j<i+8;j++){
  813.          if(j<0)j=0;
  814.          if((e=arg[j]-'0')>1)die(Ehex);
  815.          d=(d<<1)|e;
  816.       }
  817.       xbyte(workptr+k,d),k+=2;
  818.    }
  819.    stack(workptr,k);
  820. }
  821. void b2d(argc)
  822. int argc;
  823. {
  824.    char *arg;
  825.    int len;
  826.    int i,n=0;
  827.    unsigned char e;
  828.    if(argc!=1)die(Ecall);
  829.    arg=delete(&len);
  830.    for(i=0;i<len;i++){
  831.       if((e=arg[i]-'0')>1)die(Ehex);
  832.       n=(n<<1)|e;
  833.       if(n<0)die(Erange);
  834.    }
  835.    stackint(n);
  836. }
  837. void d2c(argc)
  838. int argc;
  839. {
  840.    unsigned int num,minus;
  841.    int n=-1;
  842.    int l;
  843.    unsigned char sign;
  844.    char *ans;
  845.    if(argc==2){
  846.       argc--;
  847.       if((n=getint(1))<0)die(Ecall);
  848.    }
  849.    if(argc!=1)die(Ecall);
  850.    num=(unsigned)getint(1);
  851.    minus=-num;
  852.    sign=-((int)num<0);
  853.    mtest(workptr,worklen,n<four?four:n,n+1+four);
  854.    if(n<0){
  855.       if(!num){
  856.          stack("",1); /* stack d2c(0) - the null char from "" */
  857.      return;
  858.       }
  859.       for(n=0,ans=workptr+four-1;num&−n++,num>>=8,minus>>=8)
  860.          *ans--=(char)num;
  861.       stack(++ans,n);
  862.       return;
  863.    }
  864.    for(l=n,ans=workptr+n-1;n--;num>>=8)*ans--=num?(char)num:sign;
  865.    stack(workptr,l);
  866. }
  867. void d2b(argc)
  868. int argc;
  869. {
  870.    int num;
  871.    char c[8*four];
  872.    int i;
  873.    if(argc!=1)die(Ecall);
  874.    if((num=getint(1))<0)die(Ecall);
  875.    if(!num)stack("00000000",8);
  876.    else{
  877.       for(i=8*four;num||(i&7);c[--i]=(num&1)+'0',num>>=1);
  878.       stack(c+i,8*four-i);
  879.    }
  880. }
  881. void d2x(argc)
  882. int argc;
  883. {
  884.    unsigned int num,minus;
  885.    unsigned char sign;
  886.    int l;
  887.    int n=-1;
  888.    char *ans;
  889.    if(argc==2){
  890.       argc--;
  891.       if((n=getint(1))<0)die(Ecall);
  892.    }
  893.    if(argc!=1)die(Ecall);
  894.    num=getint(1);
  895.    minus=-num;
  896.    sign=-((int)num<0);
  897.    if(n<0){
  898.       if(!num){stack("0",1);return;}
  899.       mtest(workptr,worklen,2*four,2*four);
  900.       for(n=0,ans=workptr+2*four-2;num&−n+=2,num>>=8,minus>>=8)
  901.          xbyte(ans,(char)num),ans-=2;
  902.       if((ans+=2)[0]==(sign?'F':'0')&&(!sign||ans[1]>'7'))ans++,n--;
  903.       stack(ans,n);
  904.    }
  905.    else{
  906.       mtest(workptr,worklen,n+1,n+1-worklen);
  907.       for(l=n,ans=workptr+n;n>0;n-=2,ans-=2,num>>=8)
  908.          xbyte(ans,num?(char)num:sign);
  909.       if(n<0)ans++;
  910.       stack(ans+2,l);
  911.    }
  912. }
  913. void x2c(argc)
  914. int argc;
  915. {
  916.    char *arg;
  917.    int len;
  918.    if(argc!=1)die(Ecall);
  919.    arg=delete(&len);
  920.    mtest(workptr,worklen,len+1,len+1-worklen);
  921.    memcpy(workptr,arg,len),
  922.    stackx(workptr,len);
  923. }
  924. void x2d(argc)
  925. int argc;
  926. {
  927.    char *arg;
  928.    int len;
  929.    int i;
  930.    int num=0;
  931.    int n=-1;
  932.    char c;
  933.    int k;
  934.    int minus=0;
  935.    if(argc==2){
  936.       if((n=getint(1))<0)die(Ecall);
  937.       argc--;
  938.    }
  939.    if(argc!=1)die(Ecall);
  940.    arg=delete(&len);
  941.    if(len<0)die(Enoarg);
  942.    if(n<0)n=len+1;
  943.    if(n==0){stack("0",1);return;}
  944.    if(n<=len){
  945.       k=n;
  946.       arg+=len-k;
  947.       if(arg[0]>='8')minus=(~(unsigned)0)<<(4*k);
  948.    }
  949.    else k=len;
  950.    for(i=0;i<k;i++){
  951.       if((c=arg[i]-'0')<0)die(Ehex);
  952.       if(c>9){
  953.          if((c-=7)<0)die(Ehex);
  954.          if(c>15)if((c-=32)<0||c>15)die(Ehex);
  955.       }
  956.       if((num=num*16+c)<0)die(Erange);
  957.    }
  958.    stackint(num|minus);
  959. }
  960. void x2b(argc)
  961. int argc;
  962. {
  963.    int i,j,a;
  964.    char *arg,*ans;
  965.    int len;
  966.    x2c(argc);
  967.    arg=delete(&len);
  968.    mtest(workptr,worklen,8*len+1,8*len+1-worklen);
  969.    for(ans=workptr,i=len;i--;arg++){
  970.       a=arg[0];
  971.       for(j=8;j--;ans++)ans[0]='0'+((a&(1<<j))!=0);
  972.    }
  973.    stack(workptr,len*8);
  974. }
  975.    
  976. void rxsystem(argc)
  977. int argc;
  978. {
  979.    char *arg;
  980.    int len;
  981.    FILE *p;
  982.    char c;
  983.    int rc;
  984.    int type;
  985.    if(argc!=1)die(Ecall);
  986.    arg=delete(&len);
  987.    arg[len]=0;
  988.    len=0;
  989.    if(p=popen(arg,"r")){ /* Open a pipe, read the output, close the pipe */
  990.       while(1){
  991.          c=getc(p);
  992.          if(feof(p)||ferror(p))break;
  993.          mtest(workptr,worklen,len+1,50);
  994.          workptr[len++]=c;
  995.       }
  996.       rc=pclose(p)/256;
  997.    }
  998.    else rc= -1;
  999.    stack(workptr,len);
  1000.    if(rc<0||rc==1)type=Efailure;
  1001.    else type=Eerror;
  1002.    rcset(rc,type,arg);
  1003. }
  1004.  
  1005. int rxseterr(info,stream) /* Set rc to indicate the I/O error which just */
  1006. struct fileinfo *info;    /* occurred on file "info", named "stream" */
  1007. char *stream;
  1008. {
  1009.    extern int errno;
  1010.    int rc=0;
  1011.    if(feof(info->fp))rc=Eeof;
  1012.    if(ferror(info->fp))rc=errno;
  1013.    if(rc)info->errno=rc+Eerrno;
  1014.    else  info->errno=0;
  1015.    rcset(rc,Enotready,stream);
  1016.    return rc;
  1017. }
  1018.  
  1019. void rxpos(argc)
  1020. int argc;
  1021. {
  1022.    char *s1,*s2,*p;
  1023.    int l1,l2,start;
  1024.    if(argc!=2&&argc!=3)die(Ecall);
  1025.    if(argc==3&&isnull())argc--,delete(&l1);
  1026.    if(argc==3)start=getint(1);
  1027.    else start=1;
  1028.    if(--start<0)die(Erange);
  1029.    p=(s1=delete(&l1))+start;
  1030.    if(l1<0)die(Enoarg);
  1031.    l1-=start,
  1032.    s2=delete(&l2);
  1033.    if(l2<0)die(Enoarg);
  1034.    if(l2==0){stack("0",1);return;}
  1035.    while(l1>=l2&&memcmp(p,s2,l2))p++,l1--;
  1036.    if(l1<l2)stack("0",1);
  1037.    else stackint(p-s1+1);
  1038. }
  1039. void rxlastpos(argc)
  1040. int argc;
  1041. {
  1042.    char *s1,*s2,*p;
  1043.    int l1,l2,start;
  1044.    if(argc!=2&&argc!=3)die(Ecall);
  1045.    if(argc==3&&isnull())argc--,delete(&l1);
  1046.    if(argc==3){
  1047.       start=getint(1);
  1048.       if(start<1)die(Erange);
  1049.    }
  1050.    else start=0;
  1051.    s1=delete(&l1),
  1052.    s2=delete(&l2);
  1053.    if(l1<0||l2<0)die(Enoarg);
  1054.    if(!l2){stack("0",1);return;}
  1055.    if(start&&start<l1)l1=start;
  1056.    p=s1+l1-l2;
  1057.    while(p>=s1&&memcmp(p,s2,l2))p--;
  1058.    if(p<s1)stack("0",1);
  1059.    else stackint(p-s1+1);
  1060. }
  1061. void rxsubstr(argc)
  1062. int argc;
  1063. {
  1064.    char *arg;
  1065.    int len;
  1066.    int len1,len2;
  1067.    int i;
  1068.    char pad=' ';
  1069.    int num;
  1070.    int strlen= -1;
  1071.    if(argc>4||argc<2)die(Ecall);
  1072.    if(argc==4){
  1073.       arg=delete(&len);
  1074.       if(len>=0)
  1075.          if(len!=1)die(Ecall);
  1076.          else pad=arg[0];
  1077.    }
  1078.    if(argc>2&&isnull())delete(&len1),argc=2;
  1079.    if(argc>2)if((strlen=getint(1))<0)die(Ecall);
  1080.    num=getint(1);
  1081.    arg=delete(&len);
  1082.    if(len<0)die(Enoarg);
  1083.    strlen=len1=strlen<0?len-num+1:strlen; /* fix up the default length */
  1084.    if(strlen<=0){          /* e.g. in substr("xyz",73) */
  1085.       stack("",0);
  1086.       return;
  1087.    }
  1088.    mtest(workptr,worklen,len1+5,len1+5);
  1089.    for(i=0;num<1&&len1;workptr[i++]=pad)num++,len1--; /* The initial padding */
  1090.    len2=len-num+1<len1?len-num+1:len1;
  1091.    if(len2<=0)len2=0;
  1092.    memcpy(workptr+i,arg+num-1,len2);  /* The substring */
  1093.    i+=len2;
  1094.    len1-=len2;
  1095.    for(;len1--;workptr[i++]=pad);    /* The final padding */
  1096.    stack(workptr,strlen);
  1097. }
  1098. void rxcentre(argc)
  1099. int argc;
  1100. {
  1101.    char *arg;
  1102.    int len;
  1103.    int num;
  1104.    int i;
  1105.    int spleft;
  1106.    char pad=' ';
  1107.    if(argc==3){
  1108.       arg=delete(&len);
  1109.       if(len>=0)
  1110.          if(len!=1)die(Ecall);
  1111.          else pad=arg[0];
  1112.       argc--;
  1113.    }
  1114.    if(argc!=2)die(Ecall);
  1115.    if((num=getint(1))<=0)die(Ecall);
  1116.    arg=delete(&len);
  1117.    if(len<0)die(Enoarg);
  1118.    mtest(workptr,worklen,num+5,num+5);
  1119.    if(len>=num)memcpy(workptr,arg+(len-num)/2,num); /* centre window on text */
  1120.    else {                                           /* centre text in window */
  1121.       spleft=(num-len)/2;
  1122.       for(i=0;i<spleft;workptr[i++]=pad);
  1123.       memcpy(workptr+i,arg,len);
  1124.       for(i+=len;i<num;workptr[i++]=pad);
  1125.    }
  1126.    stack(workptr,num);
  1127. }
  1128. void rxjustify(argc)
  1129. int argc;
  1130. {
  1131.    char *arg,*ptr;
  1132.    int len;
  1133.    int num;
  1134.    int i,j;
  1135.    int sp;
  1136.    int n=0;
  1137.    int a;
  1138.    char pad=' ';
  1139.    if(argc==3){
  1140.       arg=delete(&len);
  1141.       if(len>=0)
  1142.          if(len!=1)die(Ecall);
  1143.      else pad=arg[0];
  1144.       argc--;
  1145.    }
  1146.    if(argc!=2)die(Ecall);
  1147.    if((num=getint(1))<=0)die(Ecall);
  1148.    rxspace(1);
  1149.    arg=delete(&len);
  1150.    if((sp=num-len)<=0){
  1151.       for(len=num,ptr=arg;len--;ptr++)if(ptr[0]==' ')ptr[0]=pad;
  1152.       stack(arg,num);
  1153.       return;
  1154.    }
  1155.    mtest(workptr,worklen,num+5,num+5);
  1156.    for(i=0;i<len;i++)if(arg[i]==' ')n++;
  1157.    if(!n){
  1158.       memcpy(workptr,arg,len);
  1159.       for(i=len;i<num;workptr[i++]=pad);
  1160.    }
  1161.    else{
  1162.       a=n/2;
  1163.       for(i=j=0;i<len;workptr[j++]=arg[i++])
  1164.          if(arg[i]==' '){
  1165.         arg[i]=pad;
  1166.             for(a+=sp;a>=n;a-=n)workptr[j++]=pad;
  1167.          }
  1168.    }
  1169.    stack(workptr,num);
  1170. }
  1171.  
  1172. void rxarg(argc)
  1173. int argc;
  1174. {
  1175.    int n;
  1176.    int i;
  1177.    int ex;
  1178.    char opt='A';
  1179.    char *arg;
  1180.    for(n=0;curargs[n];n++); /* count arguments to current procedure */
  1181.    if(argc>2)die(Ecall);
  1182.    if(argc>0&&isnull()){
  1183.       delete(&i);
  1184.       argc--;
  1185.       if(argc>0&&isnull()){
  1186.          delete(&i);
  1187.          argc--;
  1188.       }
  1189.    }
  1190.    if(argc==0){stackint(n);return;}
  1191.    if(argc==2){
  1192.       arg=delete(&i);
  1193.       if(i<1)die(Ecall);
  1194.       if((opt=arg[0]&0xdf)!='E'&&opt!='O')die(Ecall);
  1195.    }
  1196.    i=getint(1);
  1197.    if(i-- <=0)die(Ecall);
  1198.    ex=(i<n &&curarglen[i]>=0);
  1199.    switch(opt){
  1200.       case 'A':if(ex)stack(curargs[i],curarglen[i]);
  1201.          else stack(cnull,0);
  1202.          break;
  1203.       case 'O':ex=!ex;
  1204.       case 'E':stack((opt='0'+ex,&opt),1);
  1205.    }
  1206. }
  1207. void rxabbrev(argc)
  1208. int argc;
  1209. {
  1210.    int al= -1;
  1211.    char *longs,*shorts;
  1212.    int longl,shortl;
  1213.    char c;
  1214.    if(argc==3&&isnull())argc--,delete(&longl);
  1215.    if(argc==3)if((argc--,al=getint(1))<0)die(Ecall);
  1216.    if(argc!=2)die(Ecall);
  1217.    shorts=delete(&shortl);
  1218.    longs=delete(&longl);
  1219.    if(shortl<0||longl<0)die(Enoarg);
  1220.    if(al<0)al=shortl;
  1221.    c= '1'-(al>shortl||shortl>longl||memcmp(longs,shorts,shortl)),
  1222.    stack(&c,1);
  1223. }
  1224.  
  1225. void rxabs(argc)
  1226. int argc;
  1227. {
  1228.    int m,e,z,l,n;
  1229.    if(argc!=1)die(Ecall);
  1230.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  1231.    delete(&m);
  1232.    stacknum(workptr+n,l,e,0);
  1233. }
  1234.  
  1235. void rxcompare(argc)
  1236. int argc;
  1237. {
  1238.    char pad=' ';
  1239.    char *s1,*s2;
  1240.    int l1,l2,l3;
  1241.    int i;
  1242.    if(argc==3){
  1243.       s1=delete(&l1);
  1244.       if(l1>=0)
  1245.          if(l1!=1)die(Ecall);
  1246.          else pad=s1[0];
  1247.       argc--;
  1248.    }
  1249.    if(argc!=2)die(Ecall);
  1250.    s2=delete(&l2),
  1251.    s1=delete(&l1);
  1252.    if(l1<0||l2<0)die(Enoarg);
  1253.    l3=((l1<l2)?l2:l1);  /* the length of the larger string */
  1254.    for(i=0;i<l3&&(i<l2?s2[i]:pad)==(i<l1?s1[i]:pad);i++);
  1255.    if(i++==l3)i=0;
  1256.    stackint(i);
  1257. }
  1258.  
  1259. void rxdelstr(argc)
  1260. int argc;
  1261. {
  1262.    int n,l,d= -1;
  1263.    int osp;
  1264.    char *s;
  1265.    if(argc==3){
  1266.       argc--;
  1267.       if(isnull())delete(&l);
  1268.       else if((d=getint(1))<0)die(Ecall);
  1269.    }
  1270.    if(argc!=2)die(Ecall);
  1271.    if((n=getint(1))<1)die(Ecall);
  1272.    osp=ecstackptr;
  1273.    s=delete(&l);
  1274.    if(l<0)die(Enoarg);
  1275.    if(n>l||!d){ecstackptr=osp;return;}/* delete nothing:return the old string*/
  1276.    mtest(workptr,worklen,l,l);
  1277.    n--;
  1278.    if(d<0||n+d>l)d=l-n;
  1279.    memcpy(workptr,s,n),
  1280.    memcpy(workptr+n,s+n+d,l-n-d);
  1281.    stack(workptr,l-d);
  1282. }
  1283.  
  1284. void rxdelword(argc)
  1285. int argc;
  1286. {
  1287.    int n,l,d= -1,n1,d1,l1,i;
  1288.    int osp;
  1289.    char *s;
  1290.    if(argc==3){
  1291.       argc--;
  1292.       if(isnull())delete(&l);
  1293.       else if((d=getint(1))<0)die(Ecall);
  1294.    }
  1295.    if(argc!=2)die(Ecall);
  1296.    if((n=getint(1))<1)die(Ecall);
  1297.    osp=ecstackptr;
  1298.    s=delete(&l1);
  1299.    if(l1<0)die(Enoarg);
  1300.    for(i=0;i<l1&&s[i]==' ';i++);
  1301.    if(i==l1||!d){ecstackptr=osp;return;}
  1302.    n--;
  1303.    for(l=0;i<l1;l++){
  1304.       if(l==n)n1=i;
  1305.       if(l==n+d&&d>0)d1=i-n1;
  1306.       while(i<l1&&s[i]!=' ')i++;
  1307.       while(i<l1&&s[i]==' ')i++;
  1308.    }
  1309.    if(n>l-1){ecstackptr=osp;return;}
  1310.    mtest(workptr,worklen,l1,l1);
  1311.    if(d<0||n+d>l-1)d1=l1-n1;
  1312.    memcpy(workptr,s,n1),
  1313.    memcpy(workptr+n1,s+n1+d1,l1-n1-d1);
  1314.    stack(workptr,l1-d1);
  1315. }
  1316.  
  1317. void rxinsert(argc)
  1318. int argc;
  1319. {
  1320.    char *new,*target;
  1321.    int nl,tl;
  1322.    int n=0,length= -1;
  1323.    int i;
  1324.    char pad=' ';
  1325.    if(argc==5){
  1326.       argc--;
  1327.       new=delete(&nl);
  1328.       if(nl>=0)
  1329.          if(nl==1)pad=new[0];
  1330.          else die(Ecall);
  1331.    }
  1332.    if(argc==4){
  1333.       argc--;
  1334.       if(isnull())delete(&nl);
  1335.       else if((length=getint(1))<0)die(Ecall);
  1336.    }
  1337.    if(argc==3){
  1338.       argc--;
  1339.       if(isnull())delete(&nl);
  1340.       else if((n=getint(1))<0)die(Ecall);
  1341.    }
  1342.    if(argc!=2)die(Ecall);
  1343.    target=delete(&tl);
  1344.    new=delete(&nl);
  1345.    if(tl<0||nl<0)die(Enoarg);
  1346.    if(length<0)length=nl;
  1347.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1348.    memcpy(workptr,target,n<tl?n:tl);
  1349.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1350.    memcpy(workptr+n,new,length<nl?length:nl);
  1351.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1352.    if(n<tl)memcpy(workptr+n+length,target+n,tl-n);
  1353.    else tl=n;
  1354.    stack(workptr,tl+length);
  1355. }
  1356.  
  1357. void rxminmax(argc,op) /* Calculate the minimum/maximum of a list of numbers */
  1358. int argc;   /* How many numbers are supplied */
  1359. int op;     /* What comparison operator to use */
  1360. {
  1361.    int m1,z1,e1,l1,n1,m2,z2,e2,l2,n2,d,owp;
  1362.    if(!argc)die(Enoarg);
  1363.    if((n1=num(&m1,&e1,&z1,&l1))<0)die(Enum);
  1364.    delete(&d);
  1365.    owp=eworkptr;
  1366.    while(--argc){
  1367.       eworkptr=owp;
  1368.       if((n2=num(&m2,&e2,&z2,&l2))<0)die(Enum);
  1369.       stacknum(workptr+n1,l1,e1,m1);
  1370.       binrel(op);
  1371.       if((delete(&d))[0]=='1')n1=n2,m1=m2,e1=e2,l1=l2,owp=eworkptr;
  1372.    }
  1373.    stacknum(workptr+n1,l1,e1,m1);
  1374. }
  1375.  
  1376. void rxmax(argc)
  1377. int argc;
  1378. {
  1379.    rxminmax(argc,OPgeq);
  1380. }
  1381.  
  1382. void rxmin(argc)
  1383. int argc;
  1384. {
  1385.    rxminmax(argc,OPleq);
  1386. }
  1387.  
  1388. void rxoverlay(argc)
  1389. int argc;
  1390. {
  1391.    char *new,*target;
  1392.    int nl,tl;
  1393.    int n=1,length= -1;
  1394.    int i;
  1395.    char pad=' ';
  1396.    if(argc==5){
  1397.       argc--;
  1398.       new=delete(&nl);
  1399.       if(nl>=0)
  1400.          if(nl==1)pad=new[0];
  1401.          else die(Ecall);
  1402.    }
  1403.    if(argc==4){
  1404.       argc--;
  1405.       if(isnull())delete(&nl);
  1406.       else if((length=getint(1))<0)die(Ecall);
  1407.    }
  1408.    if(argc==3){
  1409.       argc--;
  1410.       if(isnull())delete(&nl);
  1411.       else if((n=getint(1))<=0)die(Ecall);
  1412.    }
  1413.    n--;
  1414.    if(argc!=2)die(Ecall);
  1415.    target=delete(&tl);
  1416.    new=delete(&nl);
  1417.    if(tl<0||nl<0)die(Enoarg);
  1418.    if(length<0)length=nl;
  1419.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1420.    memcpy(workptr,target,n<tl?n:tl);
  1421.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1422.    memcpy(workptr+n,new,length<nl?length:nl);
  1423.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1424.    if(n+length<tl)memcpy(workptr+n+length,target+n+length,tl-n-length);
  1425.    else tl=n+length;
  1426.    stack(workptr,tl);
  1427. }
  1428.  
  1429. void rxrandom(argc)
  1430. int argc;
  1431. {
  1432.    struct timeval t1;
  1433.    struct timezone tz;
  1434.    int min=0,max=999;
  1435.    int dummy;
  1436.    long random();
  1437.    unsigned long r;
  1438.    if(argc==3){
  1439.       argc--;
  1440.       srandom(getint(1)),timeflag|=4;
  1441.    }
  1442.    if(!(timeflag&4)){
  1443.       timeflag|=4;
  1444.       gettimeofday(&t1,&tz);
  1445.       srandom(t1.tv_sec*50+(t1.tv_usec/19999));
  1446.    }
  1447.    if(argc>2)die(Ecall);
  1448.    if(argc&&isnull())argc--,delete(&dummy);
  1449.    if(argc&&isnull())argc--,delete(&dummy);
  1450.    if(argc)argc--,max=getint(1);
  1451.    if(argc)
  1452.       if(isnull())delete(&dummy);
  1453.       else min=getint(1);
  1454.    if(min>max||max-min>100000)die(Ecall);
  1455.    if(min==max)r=0;
  1456.    else max=max-min+1,
  1457.         r=(unsigned long)random()%max;
  1458.    stackint((int)r+min);
  1459. }
  1460.  
  1461. void rxreverse(argc)
  1462. int argc;
  1463. {
  1464.    char *s;
  1465.    int i,l,l2;
  1466.    char c;
  1467.    if(argc!=1)die(Ecall);
  1468.    s=undelete(&l);
  1469.    l2=l--/2;
  1470.    for(i=0;i<l2;i++)c=s[i],s[i]=s[l-i],s[l-i]=c;
  1471. }
  1472.  
  1473. void rxsign(argc)
  1474. int argc;
  1475. {
  1476.    int m,z,e,l;
  1477.    char c;
  1478.    if(argc!=1)die(Ecall);
  1479.    if(num(&m,&e,&z,&l)<0)die(Enum);
  1480.    delete(&l);
  1481.    if(m)stack("-1",2);
  1482.    else c='1'-z,stack(&c,1);
  1483. }
  1484.  
  1485. void rxsubword(argc)
  1486. int argc;
  1487. {
  1488.    char *s;
  1489.    int l,n,k= -1,i,n1,k1,l1;
  1490.    if(argc==3){
  1491.       if((k=getint(1))<0)die(Ecall);
  1492.       argc--;
  1493.    }
  1494.    if(argc!=2)die(Ecall);
  1495.    if((n=getint(1))<=0)die(Ecall);
  1496.    s=delete(&l1);
  1497.    if(l1<0)die(Enoarg);
  1498.    for(i=0;i<l1&&s[i]==' ';i++);
  1499.    n--;
  1500.    for(l=0;i<l1;l++){
  1501.       if(n==l)n1=i;
  1502.       if(k>=0&&k+n==l)k1=i-n1;
  1503.       while(i<l1&&s[i]!=' ')i++;
  1504.       while(i<l1&&s[i]==' ')i++;
  1505.    }
  1506.    if(n>=l||k==0){stack(cnull,0);return;}
  1507.    if(k<0||k+n>=l)k1=l1-n1;
  1508.    while(k1>0&&s[n1+k1-1]==' ')k1--;
  1509.    stack(s+n1,k1);
  1510. }
  1511.  
  1512. void rxsymbol(argc)
  1513. int argc;
  1514. {
  1515.    char *arg;
  1516.    int len,good;
  1517.    int m,e,z,l;
  1518.    if(argc!=1)die(Ecall);
  1519.    if(num(&m,&e,&z,&l)>=0){
  1520.       delete(&l);
  1521.       stack("LIT",3); /* (was NUM) All numbers are constant symbols */
  1522.    }
  1523.    else{
  1524.       arg=rxgetname(&len,&good);
  1525.       if(!len)good=0;
  1526. /*    if(good==1&&rexxsymbol(arg[0]&0x7f)<1)good=0; */
  1527. /* Constant symbols give "LIT"; uncomment the above to give "BAD" */
  1528.       if(good&&varget(arg,len,&l)) stack("VAR",3);
  1529.       else if(!good)stack("BAD",3);
  1530.       else stack("LIT",3);
  1531.    }
  1532. }
  1533.  
  1534. void rxlate(argc)
  1535. int argc;
  1536. {
  1537.    char *s,*ti,*to;
  1538.    int sl,til= -1,tol=-1;
  1539.    int j;
  1540.    char pad=' ';
  1541.    if(argc==4){
  1542.       s=delete(&sl);
  1543.       if(sl==1)pad=s[0];
  1544.       else die(Ecall);
  1545.       argc--;
  1546.    }
  1547.    if(argc==3)argc--,ti=delete(&til);
  1548.    if(argc==2)argc--,to=delete(&tol);
  1549.    if(argc!=1)die(Ecall);
  1550.    s=undelete(&sl);
  1551.    if(sl<0)die(Enoarg);
  1552.    if(tol==-1&&til== -1)for(;sl--;s++)s[0]=uc(s[0]);
  1553.    else for(;sl--;s++){
  1554.       if(til== -1)j=s[0];
  1555.       else{
  1556.          for(j=0;j<til&&s[0]!=ti[j];j++);
  1557.          if(j==til)continue;
  1558.       }
  1559.       if(j>=tol)s[0]=pad;
  1560.       else s[0]=to[j];
  1561.    }
  1562. }
  1563.  
  1564. void rxtrunc(argc)
  1565. int argc;
  1566. {
  1567.    int d=0,n,m,e,z,l,i;
  1568.    char *p;
  1569.    if(argc==2){
  1570.       if(isnull())delete(&l);
  1571.       else if((d=getint(1))<0||d>5000)die(Ecall);
  1572.       argc--;
  1573.    }
  1574.    if(argc!=1)die(Ecall);
  1575.    eworkptr=2; /* Save room for a carry digits */
  1576.    if((n=num(&m,&e,&z,&l))<0)die(Enum); /* Get the number to truncate */
  1577.    delete(&i);
  1578.    if(e>0)i=l+d+e+5;
  1579.    else i=l+d+5;
  1580.    mtest(workptr,worklen,i,i);
  1581.    p=workptr+n;
  1582.    if(l>precision)  /* round it to precision before truncating */
  1583.    if(p[l=precision]>='5'){
  1584.       for(i=l-1;i>=0;i--){
  1585.          p[i]++;
  1586.          if(p[i]<='9')break;
  1587.          p[i]='0';
  1588.       }
  1589.       if(i<0)(--p)[0]='1',e++;
  1590.    }
  1591.    for(i=l;i<=e;p[i++]='0'); /* Extend the number to the decimal point */
  1592.    if(d==0&&e<0){p[0]='0';stack(p,1);return;}  /* 0 for trunc(x) where |x|<1 */
  1593.    if(d>0){
  1594.       if(e<0){
  1595.          if(e<-d)e= -d-1;
  1596.          for(i=l;i--;)p[i-e]=p[i];
  1597.          for(i=0;i<-e;p[i++]='0');
  1598.          l-=e;
  1599.          e=0;
  1600.       }
  1601.       if(l>e+1)for(i=l;i>e;i--)p[i+1]=p[i];
  1602.       p[e+1]='.';
  1603.       if(l<e+2)l=e+2;
  1604.       else l++;
  1605.       for(i=l;i<e+d+2;p[i++]='0');
  1606.       d++;
  1607.    }
  1608.    if(m)(--p)[0]='-',d++;
  1609.    stack(p,d+e+1);
  1610. }
  1611.  
  1612. void rxverify(argc)
  1613. int argc;
  1614. {
  1615.    char *s,*r;
  1616.    int sl,rl,st=1,opt=0;
  1617.    int i,j;
  1618.    if(argc==4){
  1619.       argc--;
  1620.       if(isnull())delete(&sl);
  1621.       else if((st=getint(1))<1)die(Ecall);
  1622.    }
  1623.    if(argc==3){
  1624.       argc--;
  1625.       s=delete(&sl);
  1626.       if(sl>=0){
  1627.          if(sl==0)die(Ecall);
  1628.          switch(s[0]&0xdf){
  1629.             case 'M':opt=1;
  1630.             case 'N':break;
  1631.             default:die(Ecall);
  1632.          }
  1633.       }
  1634.    }
  1635.    if(argc!=2)die(Ecall);
  1636.    r=delete(&rl),
  1637.    s=delete(&sl);
  1638.    if(rl<0||sl<0)die(Enoarg);
  1639.    if(st>sl)i=0;
  1640.    else{
  1641.       s+=(--st);
  1642.       for(i=st;i<sl;i++,s++){
  1643.          for(j=0;j<rl&&s[0]!=r[j];j++);
  1644.          if((j==rl)^opt)break;
  1645.       }
  1646.       if(i==sl)i=0;
  1647.       else i++;
  1648.    }
  1649.    stackint(i); 
  1650. }
  1651.  
  1652. void rxword(argc)
  1653. int argc;
  1654. {
  1655.    if(argc!=2)die(Ecall);
  1656.    stack("1",1);
  1657.    rxsubword(3);
  1658. }
  1659.  
  1660. void rxwordindex(argc)
  1661. int argc;
  1662. {
  1663.    char *s;
  1664.    int sl,n,i,l;
  1665.    if(argc!=2)die(Ecall);
  1666.    if((n=getint(1))<1)die(Ecall);
  1667.    s=delete(&sl);
  1668.    if(sl<0)die(Enoarg);
  1669.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  1670.    n--;
  1671.    for(l=0;i<sl;l++){
  1672.       if(n==l)break;
  1673.       while(i<sl&&s[0]!=' ')i++,s++;
  1674.       while(i<sl&&s[0]==' ')i++,s++;
  1675.    }
  1676.    if(i==sl)i=0;
  1677.    else i++;
  1678.    stackint(i);
  1679. }
  1680.  
  1681. void rxwordlength(argc)
  1682. int argc;
  1683. {
  1684.    rxword(argc);
  1685.    rxlength(1);
  1686. }
  1687.  
  1688. void rxwordpos(argc)
  1689. int argc;
  1690. {
  1691.    char *p,*s;
  1692.    int pl,sl,st=1;
  1693.    int i,l,j,k;
  1694.    if(argc==3){
  1695.       if((st=getint(1))<1)die(Ecall);
  1696.       argc--;
  1697.    }
  1698.    if(argc!=2)die(Ecall);
  1699.    s=delete(&sl),
  1700.    p=delete(&pl);
  1701.    if(sl<0||pl<0)die(Enoarg);
  1702.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  1703.    while(pl&&p[0]==' ')p++,pl--;
  1704.    while(pl--&&p[pl]==' ');
  1705.    if(!++pl){stack("0",1);return;}
  1706.    st--;
  1707.    for(l=0;i<sl;l++){
  1708.       if(l>=st){
  1709.          for(j=k=0;j<pl&&k<sl-i;j++,k++){
  1710.             if(s[k]!=p[j])break;
  1711.             if(s[k]!=' ')continue;
  1712.             while(++k<sl-i&&s[k]==' ');
  1713.             while(++j<pl&&p[j]==' ');
  1714.             j--,k--;
  1715.          }
  1716.          if(j==pl)break;
  1717.          if(k==sl-i){l= -1;break;}
  1718.       }
  1719.       while(i<sl&&s[0]!=' ')i++,s++;
  1720.       while(i<sl&&s[0]==' ')i++,s++;
  1721.    }
  1722.    if(i==sl)l=0;
  1723.    else l++;
  1724.    stackint(l);
  1725. }
  1726.  
  1727. void rxwords(argc)
  1728. int argc;
  1729. {
  1730.    char *s;
  1731.    int l1,l;
  1732.    if(argc!=1)die(Ecall);
  1733.    s=delete(&l1);
  1734.    while(l1&&s[0]==' ')s++,l1--;
  1735.    for(l=0;l1;l++){
  1736.       while(l1&&s[0]!=' ')s++,l1--;
  1737.       while(l1&&s[0]==' ')s++,l1--;
  1738.    }
  1739.    stackint(l);
  1740. }
  1741.  
  1742. void rxdigits(argc)
  1743. int argc;
  1744. {
  1745.    if(argc)die(Ecall);
  1746.    stackint(precision);
  1747. }
  1748.  
  1749. void rxfuzz(argc)
  1750. int argc;
  1751. {
  1752.    if(argc)die(Ecall);
  1753.    stackint(precision-fuzz);
  1754. }
  1755.  
  1756. void rxaddress(argc)
  1757. int argc;
  1758. {
  1759.    extern char *address; /* from rexx.c */
  1760.    if(argc)die(Ecall);
  1761.    stack(address,strlen(address));
  1762. }
  1763.  
  1764. void rxtrace(argc)
  1765. int argc;
  1766. {
  1767.    char *arg;
  1768.    int len;
  1769.    char ans[2];
  1770.    int q=0;
  1771.    if(argc>1)die(Ecall);
  1772.    if(trcflag&Tinteract)ans[q++]='?';
  1773.    switch(trcflag&~Tinteract&0xff){
  1774.       case Tclauses:             ans[q]='A';break;
  1775.       case Tcommands|Terrors:    ans[q]='C';break;
  1776.       case Terrors:              ans[q]='E';break;
  1777.       case Tfailures:            ans[q]='F';break;
  1778.       case Tclauses|Tintermed:   ans[q]='I';break;
  1779.       case Tlabels:              ans[q]='L';break;
  1780.       case 0:                    ans[q]='O';break;
  1781.       case Tresults|Tclauses:    ans[q]='R';
  1782.    }
  1783.    if(argc){
  1784.       arg=delete(&len);
  1785.       if(!(trcflag&Tinteract)&&interact<0 ||
  1786.           (interact==interplev-1 && interact>=0)){
  1787.                /* if interactive trace, only interpret
  1788.                   trace in the actual command, also use old trace flag
  1789.           as the starting value */
  1790.          if (interact>=0)trclp=2,trcflag=otrcflag;
  1791.      arg[len]=0;
  1792.          settrace(arg);
  1793.       }
  1794.    }
  1795.    stack(ans,++q);
  1796. }
  1797.  
  1798. void rxform(argc)
  1799. int argc;
  1800. {
  1801.    if(argc)die(Ecall);
  1802.    if(numform)stack("ENGINEERING",11);
  1803.          else stack("SCIENTIFIC",10);
  1804. }
  1805.  
  1806. void rxformat(argc)
  1807. int argc;
  1808. {
  1809.    int n,l,e,m,z;
  1810.    int before=0,after= -1, expp= -1,expt= precision;
  1811.    char *ptr1;
  1812.    int len1=0;
  1813.    int i;
  1814.    int p;
  1815.    int c=argc;
  1816.    char *num1;
  1817.    int exp;
  1818.    if(argc==5){  /* Get the value of expt */
  1819.       argc--;
  1820.       if(!isnull()){if((expt=getint(1))<0)die(Ecall);}
  1821.       else delete(&i);
  1822.    }
  1823.    if(argc==4){  /* Get the value of expp */
  1824.       argc--;
  1825.       if(!isnull()){if((expp=getint(1))<0)die(Ecall);}
  1826.       else delete(&i);
  1827.    }
  1828.    if(argc==3){  /* Get the value of after */
  1829.       argc--;
  1830.       if(!isnull()){if((after=getint(1))<0)die(Ecall);}
  1831.       else delete(&i);
  1832.    }
  1833.    if(argc==2){  /* Get the value of before */
  1834.       argc--;
  1835.       if(!isnull()){if((before=getint(1))<=0)die(Ecall);}
  1836.       else delete(&i);
  1837.    }
  1838.    if(argc!=1)die(Ecall); /* The number to be formatted must be supplied */
  1839.    eworkptr=1;            /* allow for overflow one place to the left */
  1840.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  1841.    delete(&i);
  1842.    num1=n+workptr;
  1843.    if(c==1){ /* A simple format(number) command, in which case */
  1844.       stacknum(num1,l,e,m);                 /* format normally */
  1845.       return;
  1846.    }
  1847.    if(l>precision) /* Before processing, the number is rounded to digits() */
  1848.       if(num1[l=precision]>='5'){
  1849.          for(i=l-1;i>=0;i--){
  1850.         if(++num1[i]<='9')break;
  1851.         num1[i]='0';
  1852.      }
  1853.      if(i<0)*--num1='1';
  1854.       }
  1855.    i=l+before+after+expp+30;
  1856.    mtest(cstackptr,cstacklen,i+ecstackptr,i);
  1857.    ptr1=cstackptr+ecstackptr;
  1858.    if(z)num1[0]='0',m=e=0,l=1;              /* adjust zero to be just "0" */
  1859.    if(exp=((e<expt&&!(e<0&&l-e-1>2*expt))||!expp)) {/* no exponent */
  1860.       if(e<0)n=1+m;  /* calculate number of places before . */
  1861.       else n=e+1+m;
  1862.       p=1+e;
  1863.    }
  1864.    else{
  1865.       if(numform)n=1+m+e%3; /* number of places before . in expon. notation */
  1866.       else n=1+m;
  1867.       p=n-m;
  1868.    }
  1869.    if((p+=after)>precision||after<0)p=precision; /* what precision? */
  1870.    if(l>p&&p>=0)  /* if l>p, round the number; if p<0 it needs rounding down */
  1871.       if(num1[l=p]>='5'){              /* anyway, so we don't need to bother */
  1872.          for(i=l-1;i>=0;i--){
  1873.             if(++num1[i]<='9')break;
  1874.             num1[i]='0';
  1875.          }
  1876.          if(i<0){
  1877.             (--num1)[0]='1';
  1878.         if(!l)l++; /* if that's the only '1' in the whole number, */
  1879.                    /* count it. */
  1880.             if(++e==expt&&expt&&expp)
  1881.            exp=0; /* just nudged into exponential form */
  1882.             if(exp){if(e>0)n++;}
  1883.             else
  1884.                if(numform)n=1+m+e%3;
  1885.                else n=1+m;
  1886.          }
  1887.       }
  1888.    /* should now have number rounded to fit into format, and n
  1889.       is the number of characters required for the integer part */
  1890.    if(before<n&&before)die(Eformat);
  1891.    for(n=before-n;n>0;n--)ptr1[len1++]=' ';
  1892.    if(m)ptr1[len1++]='-';
  1893.    if(exp){/* stack floating point number; no exponent */
  1894.       if(e<0){
  1895.          ptr1[len1++]='0';
  1896.          if(after){
  1897.             ptr1[len1++]='.';
  1898.             for(i= -1;i>e&&after;i--)ptr1[len1++]='0',after--;
  1899.          }
  1900.       }
  1901.       while(l&&(e>=0||after)){
  1902.          ptr1[len1++]=num1[0],
  1903.          num1++,
  1904.          l--,
  1905.          e--;
  1906.          if(l&&e==-1&&after)ptr1[len1++]='.';
  1907.          if(e<-1)after--;
  1908.       }
  1909.       while(e>-1)ptr1[len1++]='0',e--;
  1910.       if(after>0){
  1911.          if(e==-1)ptr1[len1++]='.';
  1912.          while(after--)ptr1[len1++]='0';
  1913.       }
  1914.    }
  1915.    else{/*stack floating point in appropriate form with exponent */
  1916.       ptr1[len1++]=num1[0];
  1917.       if(numform)while(e%3)
  1918.             e--,
  1919.             ptr1[len1++]=((--l)>0 ? (++num1)[0] : '0');
  1920.       else --l;
  1921.       if(l>0&&after){
  1922.          ptr1[len1++]='.';
  1923.          while(l--&&after)ptr1[len1++]=(++num1)[0],after--;
  1924.          while(after-- >0)ptr1[len1++]='0';
  1925.       }
  1926.       if(!e){
  1927.          if(expp>0)for(i=expp+2;i--;ptr1[len1++]=' ');
  1928.       }
  1929.       else{
  1930.          ptr1[len1++]='E',
  1931.          ptr1[len1++]= e<0 ? '-' : '+',
  1932.          e=abs(e);
  1933.          for(p=0,i=1;i<=e;i*=10,p++);
  1934.          if(expp<0)expp=p;
  1935.          if(expp<p)die(Eformat);
  1936.          for(p=expp-p;p--;ptr1[len1++]='0');
  1937.          for(i/=10;i>=1;i/=10)
  1938.             ptr1[len1++]=e/i+'0',
  1939.             e%=i;
  1940.       }
  1941.    }
  1942.    *(int *)(ptr1+align(len1))=len1;
  1943.    ecstackptr+=align(len1)+four;
  1944. }
  1945.  
  1946. void rxqueued(argc)
  1947. int argc;
  1948. {
  1949.    int l;
  1950.    static char buff[8];
  1951.    if(argc)die(Ecall);
  1952.    if(write(rxstacksock,"N",1)<1)die(Esys);
  1953.    if(read(rxstacksock,buff,7)<7)die(Esys);
  1954.    sscanf(buff,"%x",&l);
  1955.    stackint(l);
  1956. }
  1957.  
  1958. void rxlinesize(argc)
  1959. int argc;
  1960. {
  1961.    int ans;
  1962.    struct winsize sz;
  1963.    if(argc)die(Ecall);
  1964.    if(!ioctl(fileno(ttyout),TIOCGWINSZ,&sz))ans=sz.ws_col;
  1965.    else ans=0;
  1966.    stackint(ans);
  1967. }
  1968.  
  1969. void rxbitand(argc)
  1970. int argc;
  1971. {
  1972.    char *arg1,*arg2,*argt;
  1973.    int len1,len2,lent;
  1974.    char pad=255;
  1975.    if(argc==3){
  1976.       argt=delete(&lent);
  1977.       if(lent!=1)die(Ecall);
  1978.       pad=argt[0];
  1979.       argc--;
  1980.    }
  1981.    if(argc==2){
  1982.       arg2=delete(&len2);
  1983.       if(len2==-1)len2=0;
  1984.    }
  1985.    else{
  1986.       if(argc!=1)die(Ecall);
  1987.       len2=0;
  1988.    }
  1989.    arg1=delete(&len1);
  1990.    if(len1<0)die(Ecall);
  1991.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  1992.    argt=cstackptr+ecstackptr;
  1993.    for(lent=0;lent<len1;lent++)
  1994.       argt[lent]=arg1[lent]&(lent<len2?arg2[lent]:pad);
  1995.    argt+=lent=align(len1);
  1996.    *(int *)argt=len1;
  1997.    ecstackptr+=lent+four;
  1998. }
  1999. void rxbitor(argc)
  2000. int argc;
  2001. {
  2002.    char *arg1,*arg2,*argt;
  2003.    int len1,len2,lent;
  2004.    char pad=0;
  2005.    if(argc==3){
  2006.       argt=delete(&lent);
  2007.       if(lent!=1)die(Ecall);
  2008.       pad=argt[0];
  2009.       argc--;
  2010.    }
  2011.    if(argc==2){
  2012.       arg2=delete(&len2);
  2013.       if(len2==-1)len2=0;
  2014.    }
  2015.    else{
  2016.       if(argc!=1)die(Ecall);
  2017.       len2=0;
  2018.    }
  2019.    arg1=delete(&len1);
  2020.    if(len1<0)die(Ecall);
  2021.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2022.    argt=cstackptr+ecstackptr;
  2023.    for(lent=0;lent<len1;lent++)
  2024.       argt[lent]=arg1[lent]|(lent<len2?arg2[lent]:pad);
  2025.    argt+=lent=align(len1);
  2026.    *(int *)argt=len1;
  2027.    ecstackptr+=lent+four;
  2028. }
  2029. void rxbitxor(argc)
  2030. int argc;
  2031. {
  2032.    char *arg1,*arg2,*argt;
  2033.    int len1,len2,lent;
  2034.    char pad=0;
  2035.    if(argc==3){
  2036.       argt=delete(&lent);
  2037.       if(lent!=1)die(Ecall);
  2038.       pad=argt[0];
  2039.       argc--;
  2040.    }
  2041.    if(argc==2){
  2042.       arg2=delete(&len2);
  2043.       if(len2==-1)len2=0;
  2044.    }
  2045.    else{
  2046.       if(argc!=1)die(Ecall);
  2047.       len2=0;
  2048.    }
  2049.    arg1=delete(&len1);
  2050.    if(len1<0)die(Ecall);
  2051.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2052.    argt=cstackptr+ecstackptr;
  2053.    for(lent=0;lent<len1;lent++)
  2054.       argt[lent]=arg1[lent]^(lent<len2?arg2[lent]:pad);
  2055.    argt+=lent=align(len1);
  2056.    *(int *)argt=len1;
  2057.    ecstackptr+=lent+four;
  2058. }
  2059.  
  2060. void rxuserid(argc)
  2061. int argc;
  2062. {
  2063.    void endpwent();
  2064.    static int uid=-1;
  2065.    int cuid;
  2066.    static struct passwd *pw=0;
  2067.    if(argc)die(Ecall);
  2068.    if((cuid=getuid())!=uid)
  2069.       uid=cuid,
  2070.       pw=getpwuid(cuid),
  2071.       endpwent();
  2072.    if(!pw)stack(cnull,0);
  2073.    else stack(pw->pw_name,strlen(pw->pw_name));
  2074. }
  2075.  
  2076. void rxgetcwd(argc)
  2077. int argc;
  2078. {
  2079.    char *getwd();
  2080.    static char name[MAXPATHLEN];
  2081.    if(argc)die(Ecall);
  2082.    getwd(name);
  2083.    stack(name,strlen(name));
  2084. }
  2085.  
  2086. void rxchdir(argc)
  2087. int argc;
  2088. {
  2089.    char *arg;
  2090.    int len;
  2091.    if(argc!=1)die(Ecall);
  2092.    arg=delete(&len);
  2093.    arg[len]=0; /* that location must exist since the length used to be
  2094.                   after the string */
  2095.    if(chdir(arg))stackint(errno);
  2096.    else stack("0",1);
  2097. }
  2098.  
  2099. void rxgetenv(argc)
  2100. int argc;
  2101. {
  2102.    char *arg;
  2103.    int len;
  2104.    if(argc!=1)die(Ecall);
  2105.    arg=delete(&len);
  2106.    arg[len]=0;
  2107.    if(arg=getenv(arg))stack(arg,strlen(arg));
  2108.    else stack(cnull,0);
  2109. }
  2110.  
  2111. void rxputenv(argc)
  2112. int argc;
  2113. {
  2114.    char *arg;
  2115.    char *eptr;
  2116.    int len;
  2117.    int exist;
  2118.    char **value;
  2119.    int path;
  2120.    if(argc!=1)die(Ecall);
  2121.    arg=delete(&len);
  2122.    arg[len++]=0;
  2123.    if(!(eptr=strchr(arg,'=')))die(Ecall);
  2124.    eptr[0]=0;
  2125.    value=(char**)hashfind(0,arg,&exist);
  2126.    path=strcmp(arg,"PATH");
  2127.    eptr[0]='=';
  2128.    putenv(arg); /* release the previous copy from the environment */
  2129.    if(!exist)*value=allocm(len);
  2130.    else if(strlen(*value)<len)
  2131.       if(!(*value=realloc(*value,len)))die(Emem);
  2132.    strcpy(*value,arg);
  2133.    if(putenv(*value))stack("1",1);
  2134.    else stack("0",1);
  2135.    if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  2136. }
  2137.  
  2138. void rxopen2(stream,mode,mlen,path,plen)
  2139. char *stream,*mode,*path;   /* implement open(stream,mode,path) */
  2140. int mlen,plen;
  2141. {
  2142.    char modeletter[3];
  2143.    struct fileinfo *info;
  2144.    FILE *fp;
  2145.    int rc;
  2146.    modeletter[0]='r';
  2147.    modeletter[1]=modeletter[2]=0;
  2148.    if(plen<=0)path=stream,plen=strlen(stream);
  2149.    if(memchr(path,0,plen))die(Ecall);
  2150.    path[plen]=0;
  2151.    if(mlen>0)switch(mode[0]&0xdf){
  2152.       case 'R': break;
  2153.       case 'W': modeletter[0]='w';
  2154.                 modeletter[1]='+';
  2155.                 break;
  2156.       case 'A': rc=access(path,F_OK);
  2157.                 modeletter[0]=rc?'w':'r';
  2158.         modeletter[1]='+';
  2159.         break;
  2160.       default:  die(Ecall);
  2161.    }
  2162.    if(info=(struct fileinfo *)hashget(1,stream,&rc)){
  2163.       fp=info->fp;          /* if "stream" already exists, perform freopen */
  2164.       free((char *)info);
  2165.       *(struct fileinfo **)hashfind(1,stream,&rc)=0;
  2166.       fp=freopen(path,modeletter,info->fp);
  2167.    }
  2168.    else fp=fopen(path,modeletter);
  2169.    if(!fp){
  2170.       stackint(errno);
  2171.       return;
  2172.    }
  2173.    if(modeletter[0]=='r'&&modeletter[1]=='+') /* for append, go to eof */
  2174.       fseek(fp,0L,2);
  2175.    info=fileinit(stream,path,fp);
  2176.    info->wr=modeletter[1]=='+';
  2177.    stack("0",1);
  2178. }
  2179.  
  2180. void rxopen(argc)
  2181. int argc;
  2182. {
  2183.    char *stream,*mode,*path;
  2184.    int len=0,mlen=0,plen;
  2185.    if(argc==3){
  2186.       argc--;
  2187.       stream=delete(&len);
  2188.       if(len<0)stream=0;
  2189.       else
  2190.          if(memchr(stream,0,len))die(Ecall);
  2191.      else stream[len]=0;
  2192.       if(!len)die(Ecall);
  2193.    }
  2194.    if(argc==2){
  2195.       argc--;
  2196.       mode=delete(&mlen);
  2197.    }
  2198.    if(argc!=1)die(Ecall);
  2199.    path=delete(&plen);
  2200.    if(plen<=0)die(Ecall);
  2201.    path[plen]=0;
  2202.    if(len<=0)stream=path,len=plen;
  2203.    rxopen2(stream,mode,mlen,path,plen);
  2204. }
  2205.  
  2206. void rxfdopen2(stream,mode,modelen,n,nlen) /* implement fdopen(stream,mode,n)*/
  2207. char *stream;
  2208. char *n;
  2209. int nlen;
  2210. char *mode;
  2211. int modelen;
  2212. {
  2213.    int fd;
  2214.    char fmode[3];
  2215.    FILE *fp;
  2216.    int streamlen=strlen(stream);
  2217.    fmode[0]='r';
  2218.    fmode[1]=fmode[2]=0;
  2219.    if(nlen<=0)n=stream,nlen=streamlen; /* default number is same as name */
  2220.    mtest(workptr,worklen,nlen+streamlen+2,nlen+streamlen+2-worklen);
  2221.    memcpy(workptr,n,nlen);
  2222.    workptr[nlen]=0;
  2223.    memcpy(workptr+nlen+1,stream,streamlen+1);
  2224.    eworkptr=nlen+streamlen+2;
  2225.    stack(workptr,nlen);
  2226.    fd=getint(1);       /* convert the fd to an integer */
  2227.    if(modelen>0)switch(mode[0]&0xdf){
  2228.       case 'R': break;
  2229.       case 'W': fmode[0]='w';
  2230.                 fmode[1]='+';
  2231.         break;
  2232.       case 'A': fmode[0]='r';
  2233.                 fmode[1]='+';
  2234.         break;
  2235.       default:  die(Ecall);
  2236.    }
  2237.    if(fp=fdopen(fd,fmode)){
  2238.       fileinit(workptr+nlen+1,cnull,fp)->wr=fmode[1]=='+';
  2239.       errno=0;
  2240.    }
  2241.    stackint(errno);
  2242. }
  2243.  
  2244. void rxfdopen(argc)
  2245. int argc;
  2246. {
  2247.    char *stream,*n,*mode;
  2248.    int len=0,nlen=0,modelen=0;
  2249.    if(argc==3){
  2250.       argc--;
  2251.       stream=delete(&len);
  2252.       if(len>0)
  2253.          if(memchr(stream,0,len))die(Ecall);
  2254.      else stream[len]=0;
  2255.       if(len==0)die(Ecall);
  2256.       stream[len]=0;
  2257.    }
  2258.    if(argc==2){
  2259.       argc--;
  2260.       mode=delete(&modelen);
  2261.       if(modelen==0)die(Ecall);
  2262.    }
  2263.    if(argc!=1)die(Ecall);
  2264.    n=delete(&nlen);
  2265.    n[nlen]=0;
  2266.    if(nlen<=0)die(Ecall);
  2267.    if(len<=0)stream=n,len=nlen;
  2268.    rxfdopen2(stream,mode,modelen,n,nlen);
  2269. }
  2270.  
  2271. void rxpopen2(stream,mode,mlen,command,comlen)
  2272. char *stream,*mode,*command;      /* implement popen(stream,mode,command) */
  2273. int mlen,comlen;
  2274. {
  2275.    char fmode[2];
  2276.    int rc;
  2277.    FILE *fp;
  2278.    struct fileinfo *info;
  2279.    fmode[0]='r';
  2280.    fmode[1]=0;
  2281.    if(mlen>0)fmode[0]=mode[0]|0x20;
  2282.    if(fmode[0]!='r'&&fmode[0]!='w')die(Ecall);
  2283.    if(comlen<=0)command=stream,comlen=strlen(stream);
  2284.    else command[comlen]=0;
  2285.    if(memchr(command,0,comlen))die(Ecall);
  2286.    if(fp=popen(command,fmode)){
  2287.       info=fileinit(stream,cnull,fp);
  2288.       info->wr=fmode[0]=='w',
  2289.       info->lastwr=info->wr;
  2290.       rc=0;
  2291.    }
  2292.    else rc=errno;
  2293.    stackint(rc);
  2294. }
  2295.  
  2296. void rxpopen(argc)
  2297. int argc;
  2298. {
  2299.    char *stream,*mode,*command;
  2300.    int len=0,mlen=0,comlen;
  2301.    if(argc==3){
  2302.       argc--;
  2303.       stream=delete(&len);
  2304.       if(len<0)stream=0;
  2305.       else
  2306.          if(memchr(stream,0,len))die(Ecall);
  2307.      else stream[len]=0;
  2308.       if(!len)die(Ecall);
  2309.    }
  2310.    if(argc==2){
  2311.       argc--;
  2312.       mode=delete(&mlen);
  2313.    }
  2314.    if(argc!=1)die(Ecall);
  2315.    command=delete(&comlen);
  2316.    if(comlen<=0)die(Ecall);
  2317.    command[comlen]=0;
  2318.    if(len<=0)stream=command,len=comlen;
  2319.    rxpopen2(stream,mode,mlen,command,comlen);
  2320. }
  2321.  
  2322. void rxlinein(argc)
  2323. int argc;
  2324. {
  2325.    char *name=0;
  2326.    int lines=1;
  2327.    int pos= 0;
  2328.    int len;
  2329.    int call;
  2330.    int ch=0;
  2331.    long filepos;
  2332.    struct fileinfo *info;
  2333.    FILE *fp;
  2334.    if(argc==3){
  2335.       argc--;
  2336.       if(isnull())delete(&len);
  2337.       else if((lines=getint(1))!=0&&lines!=1)die(Ecall);
  2338.    }
  2339.    if(argc==2){
  2340.       argc--;
  2341.       if(isnull())delete(&len);
  2342.       else if((pos=getint(1))<1)die(Ecall);
  2343.    }
  2344.    if(argc==1){
  2345.       argc--;
  2346.       name=delete(&len);
  2347.       if(len<0)name=0;
  2348.       else
  2349.          if(memchr(name,0,len))die(Ecall);
  2350.      else name[len]=0;
  2351.       if(!len)die(Ecall);
  2352.    }
  2353.    if(argc)die(Ecall);
  2354.    if(!name)name="stdin";
  2355.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){/* If not found, then */
  2356.       fp=fopen(name,"r");                             /* open it for reading */
  2357.       info=fileinit(name,name,fp);
  2358.       if(!fp){
  2359.          info->errno=errno+Eerrno;
  2360.          rcset(errno,Enotready,name);
  2361.      stack(cnull,0);
  2362.      return;
  2363.       }
  2364.       info->lastwr=0;
  2365.    }
  2366.    else fp=info->fp;
  2367.    if(!fp){
  2368.       rcset(info->errno-Eerrno,Enotready,name);
  2369.       stack(cnull,0);
  2370.       return;
  2371.    }
  2372.    if(info->persist && info->lastwr==0 &&
  2373.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2374.       info->rdpos=filepos,
  2375.       info->rdline=0; /* position has been disturbed by external prog */
  2376.    clearerr(fp);      /* Ignore errors and try from scratch */
  2377.    info->errno=0;
  2378.    if(info->lastwr || pos>0)len=fseek(fp,info->rdpos,0);
  2379.    else len=0;
  2380.    info->lastwr=0;
  2381.    if(pos>0 && (len<0 || !info->persist)){
  2382.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2383.       rcset(Eseek-Eerrno,Enotready,name);
  2384.       stack(cnull,0);
  2385.       return;
  2386.    }
  2387.    if(pos>0){                   /* Search for given line number (ugh!) */
  2388.       if(info->rdline==0 || info->rdline+info->rdchars>pos)
  2389.          fseek(fp,0L,0),
  2390.      info->rdline=1;
  2391.       info->rdchars=0;
  2392.       for(;ch!=EOF&&info->rdline<pos;info->rdline++)
  2393.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2394.       if(ch==EOF){
  2395.          info->rdline--;
  2396.      info->errno=Ebounds;
  2397.          rcset(Ebounds-Eerrno,Enotready,name);
  2398.      stack(cnull,0);
  2399.      return;
  2400.       }
  2401.    }
  2402.    len=0;
  2403.    if(lines){
  2404.       call=sgstack[interplev].callon&(1<<Ihalt) |
  2405.            sgstack[interplev].delay &(1<<Ihalt);
  2406.       if(!call)siginterrupt(2,1); /* Allow ^C during read */
  2407.       while((ch=getc(fp))!='\n'&&ch!=EOF){
  2408.          mtest(pull,pulllen,len+1,256);
  2409.          pull[len++]=ch;
  2410.       }
  2411.       siginterrupt(2,0);
  2412.       if(delayed[Ihalt] && !call)
  2413.          delayed[Ihalt]=0,
  2414.          fseek(fp,info->rdpos,0), /* reset to start of line, if possible */
  2415.          die(Ehalt);
  2416.       if(info->rdline)info->rdline++;
  2417.       info->rdchars=0;
  2418.    }
  2419.    if((info->rdpos=ftell(fp))<0)info->rdpos=0;
  2420.    if(ch==EOF&&!len)rxseterr(info,name);
  2421.    stack(pull,len);
  2422. }
  2423.       
  2424. void rxlineout(argc)
  2425. int argc;
  2426. {
  2427.    char *name=0;
  2428.    char *file;
  2429.    int pos= 0;
  2430.    int charlen=0;
  2431.    int len;
  2432.    int acc;
  2433.    int ch=0;
  2434.    char *chars=0;
  2435.    long filepos;
  2436.    struct fileinfo *info;
  2437.    FILE *fp;
  2438.    if(argc==3){
  2439.       argc--;
  2440.       if(isnull())delete(&len);
  2441.       else if((pos=getint(1))<1)die(Ecall);
  2442.    }
  2443.    if(argc==2){
  2444.       argc--;
  2445.       chars=delete(&charlen);
  2446.       if(charlen<0)chars=0;
  2447.       else if(memchr(chars,'\n',charlen))die(Ecall);
  2448.    }
  2449.    if(argc==1){
  2450.       argc--;
  2451.       name=delete(&len);
  2452.       if(len<0)name=0;
  2453.       else
  2454.          if(memchr(name,0,len))die(Ecall);
  2455.      else name[len]=0;
  2456.       if(!len)die(Ecall);
  2457.    }
  2458.    if(argc)die(Ecall);
  2459.    if(!name)name="stdout";
  2460.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2461.       acc=access(name,F_OK);  /* If not found in table, then open for append */
  2462.       fp=fopen(name,acc?"w+":"r+");
  2463.       if(fp)fseek(fp,0L,2);
  2464.       info=fileinit(name,name,fp);
  2465.       if(!fp){
  2466.          info->errno=errno+Eerrno;
  2467.          rcset(errno,Enotready,name);
  2468.      stack(chars?"1":"0",1);
  2469.      return;
  2470.       }
  2471.       info->wr=1;
  2472.    }
  2473.    else fp=info->fp;
  2474.    if(!fp){
  2475.       rcset(info->errno-Eerrno,Enotready,name);
  2476.       stack(chars?"1":"0",1);
  2477.       return;
  2478.    }
  2479.    if(!info->wr){  /* If it is open for reading, try to reopen for writing */
  2480.       file=(char*)(info+1);
  2481.       if(!file[0]){ /* reopen not allowed, since file name not given */
  2482.          info->errno=Eaccess;
  2483.          rcset(Eaccess-Eerrno,Enotready,name);
  2484.      stack(chars?"1":"0",1);
  2485.      return;
  2486.       }
  2487.       if(!(fp=freopen(file,"r+",fp))){
  2488.          info->errno=errno+Eerrno;
  2489.      fp=fopen(file,"r");/* try to regain read access */
  2490.      info->fp=fp;
  2491.      if(fp)fseek(fp,info->rdpos,0);
  2492.          rcset(info->errno-Eerrno,Enotready,name);
  2493.          stack(chars?"1":"0",1);
  2494.      file[0]=0;         /* Prevent this whole thing from happening again */
  2495.      return;
  2496.       }
  2497.       info->wr=1;
  2498.       fseek(fp,0L,2);
  2499.       info->wrline=0;
  2500.       info->lastwr=1;
  2501.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2502.    }
  2503.    if(info->persist && info->lastwr &&
  2504.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  2505.       info->wrpos=filepos,
  2506.       info->wrline=0;  /* position has been disturbed by external prog */
  2507.    clearerr(fp);       /* Ignore errors and try from scratch */
  2508.    info->errno=0;
  2509.    if(info->lastwr==0 || pos>0)len=fseek(fp,info->wrpos,0);
  2510.    else len=0;
  2511.    info->lastwr=1;
  2512.    if(pos>0 && (len<0 || !info->persist)){
  2513.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2514.       rcset(Eseek-Eerrno,Enotready,name);
  2515.       stack(chars?"1":"0",1);
  2516.       return;
  2517.    }
  2518.    if(pos>0){                   /* Search for required line number (Ugh!) */
  2519.       if(info->wrline==0 || info->wrline+info->wrchars>pos)
  2520.          fseek(fp,0L,0),
  2521.      info->wrline=1;
  2522.       info->wrchars=0;
  2523.       for(;ch!=EOF&&info->wrline<pos;info->wrline++)
  2524.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2525.       fseek(fp,0L,1);          /* seek between read and write */
  2526.       if(ch==EOF){
  2527.          info->wrline--;
  2528.      info->errno=Ebounds;
  2529.      rcset(Ebounds-Eerrno,Enotready,name);
  2530.      stack(chars?"1":"0",1);
  2531.      return;
  2532.       }
  2533.    }
  2534.    if(!chars){
  2535.       if(!pos){
  2536.          fflush(fp); /* No data and no position given so flush and go to EOF */
  2537.      fseek(fp,0L,2);
  2538.      info->wrline=0;
  2539.       }
  2540.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* just pos given */
  2541.       stack("0",1);
  2542.       return;
  2543.    }
  2544.    chars[charlen++]='\n';
  2545.    if(fwrite(chars,charlen,1,fp)){
  2546.       stack("0",1);
  2547.       if(info->wrline)info->wrline++;
  2548.       info->wrchars=0;
  2549.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2550.    }else{
  2551.       stack("1",1);
  2552.       rxseterr(info,name);
  2553.       fseek(fp,info->wrpos,0);
  2554.    }
  2555. }
  2556.  
  2557. void rxcharin(argc)
  2558. int argc;
  2559. {
  2560.    char *name=0;
  2561.    int chars=1;
  2562.    int pos= 0;
  2563.    int len;
  2564.    int l;
  2565.    int call;
  2566.    long filepos;
  2567.    struct fileinfo *info;
  2568.    FILE *fp;
  2569.    if(argc==3){
  2570.       argc--;
  2571.       if(isnull())delete(&len);
  2572.       else if((chars=getint(1))<0)die(Ecall);
  2573.    }
  2574.    if(argc==2){
  2575.       argc--;
  2576.       if(isnull())delete(&len);
  2577.       else if((pos=getint(1))<1)die(Ecall);
  2578.    }
  2579.    if(argc==1){
  2580.       argc--;
  2581.       name=delete(&len);
  2582.       if(len<0)name=0;
  2583.       else
  2584.          if(memchr(name,0,len))die(Ecall);
  2585.      else name[len]=0;
  2586.       if(!len)die(Ecall);
  2587.    }
  2588.    if(argc)die(Ecall);
  2589.    if(!name)name="stdin";
  2590.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2591.       fp=fopen(name,"r"); /* not found in table so try to open */
  2592.       info=fileinit(name,name,fp);
  2593.       if(!fp){
  2594.          info->errno=errno+Eerrno;
  2595.          rcset(errno,Enotready,name);
  2596.          stack(cnull,0);
  2597.          return;
  2598.       }
  2599.       info->lastwr=0;
  2600.    }
  2601.    else fp=info->fp;
  2602.    if(!fp){
  2603.       rcset(info->errno-Eerrno,Enotready,name);
  2604.       stack(cnull,0);
  2605.       return;
  2606.    }
  2607.    if(info->persist && info->lastwr==0 &&
  2608.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2609.       info->rdpos=filepos,
  2610.       info->rdline=0; /* position has been disturbed by external prog */
  2611.    clearerr(fp);
  2612.    info->errno=0;
  2613.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  2614.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2615.       rcset(Eseek-Eerrno,Enotready,name);
  2616.       stack(cnull,0);
  2617.       return;
  2618.    }
  2619.    if(pos){
  2620.       filepos=ftell(fp);      
  2621.       if(fseek(fp,(long)pos-1,0)>=0)info->rdpos=pos-1;
  2622.       info->rdline=0;
  2623.       if(filepos<pos){          /* Seek was out of bounds */
  2624.          info->errno=Ebounds;
  2625.      rcset(Ebounds-Eerrno,Enotready,name);
  2626.      stack(cnull,0);
  2627.      return;
  2628.       }
  2629.    }
  2630.    else if(info->lastwr)fseek(fp,info->rdpos,0);
  2631.    info->lastwr=0;
  2632.    call=sgstack[interplev].callon&(1<<Ihalt) |
  2633.         sgstack[interplev].delay &(1<<Ihalt);
  2634.    if(!call)siginterrupt(2,1); /* allow ^C to interrupt */
  2635.    mtest(workptr,worklen,chars,chars-worklen);
  2636.    len=fread(workptr,1,chars,fp);
  2637.    siginterrupt(2,0);
  2638.    if(delayed[Ihalt] && !call)
  2639.       delayed[Ihalt]=0,
  2640.       fseek(fp,info->rdpos,0),
  2641.       die(Ehalt);
  2642.    if(len&&info->rdline){ /* Try to keepo the line counter up to date */
  2643.       for(l=0;l<len;)if(workptr[l++]=='\n')info->rdline++;
  2644.       if(workptr[len-1]!='\n')info->rdchars=1;
  2645.    }
  2646.    if((info->rdpos=ftell(fp))<0)info->rdpos=0;
  2647.    if(len<chars)rxseterr(info,name);
  2648.    stack(workptr,len);
  2649. }
  2650.  
  2651. void rxcharout(argc)
  2652. int argc;
  2653. {
  2654.    char *name=0;
  2655.    char *file;
  2656.    int pos= 0;
  2657.    int charlen;
  2658.    int len;
  2659.    int acc;
  2660.    int l;
  2661.    char *chars=0;
  2662.    long filepos;
  2663.    struct fileinfo *info;
  2664.    FILE *fp;
  2665.    if(argc==3){
  2666.       argc--;
  2667.       if(isnull())delete(&len);
  2668.       else if((pos=getint(1))<1)die(Ecall);
  2669.    }
  2670.    if(argc==2){
  2671.       argc--;
  2672.       chars=delete(&charlen);
  2673.       if(charlen<0)chars=0,charlen=0;
  2674.    }
  2675.    else charlen=0;
  2676.    if(argc==1){
  2677.       argc--;
  2678.       name=delete(&len);
  2679.       if(len<0)name=0;
  2680.       else
  2681.          if(memchr(name,0,len))die(Ecall);
  2682.      else name[len]=0;
  2683.       if(!len)die(Ecall);
  2684.    }
  2685.    if(argc)die(Ecall);
  2686.    if(!name)name="stdout";
  2687.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2688.       acc=access(name,F_OK); /* If not found in table, open for append */
  2689.       fp=fopen(name,acc?"w+":"r+");
  2690.       if(fp)fseek(fp,0L,2);
  2691.       info=fileinit(name,name,fp);
  2692.       if(!fp){
  2693.          info->errno=errno+Eerrno;
  2694.          rcset(errno,Enotready,name);
  2695.      stackint(charlen);
  2696.      return;
  2697.       }
  2698.       info->wr=1;
  2699.    }
  2700.    else fp=info->fp;
  2701.    if(!fp){
  2702.       rcset(info->errno-Eerrno,Enotready,name);
  2703.       stackint(charlen);
  2704.       return;
  2705.    }
  2706.    if(!info->wr){ /* If not open for write, try to gain write access */
  2707.       file=(char*)(info+1);
  2708.       if(!file[0]){
  2709.          info->errno=Eaccess;
  2710.          rcset(Eaccess-Eerrno,Enotready,name);
  2711.          stackint(charlen);
  2712.          return;
  2713.       }
  2714.       if(!(fp=freopen(file,"r+",fp))){
  2715.          info->errno=errno+Eerrno;
  2716.          fp=fopen(file,"r");/* try to regain read access */
  2717.          info->fp=fp;
  2718.          if(fp)fseek(fp,info->rdpos,0);
  2719.          rcset(info->errno-Eerrno,Enotready,name);
  2720.          stackint(charlen);
  2721.      file[0]=0;         /* Prevent this whole thing from happening again */
  2722.          return;
  2723.       }
  2724.       info->wr=1;
  2725.       fseek(fp,0L,2);
  2726.       info->wrline=0;
  2727.       info->lastwr=1;
  2728.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2729.    }
  2730.    if(info->persist && info->lastwr &&
  2731.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  2732.       info->wrpos=filepos,
  2733.       info->wrline=0;  /* position has been disturbed */
  2734.    clearerr(fp);
  2735.    info->errno=0;
  2736.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  2737.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2738.       rcset(Eseek-Eerrno,Enotready,name);
  2739.       stackint(charlen);
  2740.       return;
  2741.    }
  2742.    if(pos){
  2743.       filepos=ftell(fp);
  2744.       if(fseek(fp,(long)pos-1,0)>=0)info->wrpos=pos-1;
  2745.       info->wrline=0;
  2746.       if(filepos+1<pos){        /* Seek was out of bounds */
  2747.          info->errno=Ebounds;
  2748.      rcset(Ebounds-Eerrno,Enotready,name);
  2749.      stack(cnull,0);
  2750.      return;
  2751.       }
  2752.    }
  2753.    else if(info->lastwr==0)fseek(fp,info->wrpos,0);
  2754.    info->lastwr=1;
  2755.    if(!chars){
  2756.       if(!pos){
  2757.          fflush(fp); /* No data, no pos, so flush and seek to EOF */
  2758.      fseek(fp,0L,2);
  2759.      info->wrline=0;
  2760.       }
  2761.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* no data, so OK */
  2762.       stack("0",1);
  2763.       return;
  2764.    }
  2765.    len=fwrite(chars,1,charlen,fp);
  2766.    info->wrpos+=len;
  2767.    if(len&&info->wrline){
  2768.       for(l=0;l<len;)if(chars[l++]=='\n')info->wrline++;
  2769.       if(chars[len-1]!='\n')info->wrchars=1;
  2770.    }
  2771.    if(len<charlen)rxseterr(info,name);
  2772.    if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2773.    stackint(charlen-len);
  2774. }
  2775.  
  2776. void rxchars(argc)
  2777. int argc;
  2778. {
  2779.    rxchars2(argc,0);
  2780. }
  2781. void rxlines(argc)
  2782. int argc;
  2783. {
  2784.    rxchars2(argc,1);
  2785. }
  2786.  
  2787. void rxchars2(argc,line) /* = rxchars(argc) if line==0, or rxlines(argc) o/w */
  2788. int argc,line;
  2789. {
  2790.    long chars;
  2791.    long(filepos);
  2792.    int lines;
  2793.    char *name=0;
  2794.    int len;
  2795.    struct fileinfo *info;
  2796.    struct stat buf;
  2797.    int ch,c2;
  2798.    FILE *fp;
  2799.    extern int errno;
  2800.       if(argc==1){
  2801.       name=delete(&len);
  2802.       if(len<0)name=0;
  2803.       else
  2804.          if(memchr(name,0,len))die(Ecall);
  2805.          else name[len]=0;
  2806.       if(!len)die(Ecall);
  2807.    }
  2808.    else if(argc)die(Ecall);
  2809.    if(!name)name="stdin";
  2810.    info=(struct fileinfo *)hashget(1,name,&len);
  2811.    if(info && !info->fp){
  2812.       rcset(info->errno-Eerrno,Enotready,name);
  2813.       stack("0",1);
  2814.       return;
  2815.    }
  2816.    if(info){
  2817.       if(info->lastwr)fseek(info->fp,info->rdpos,0);
  2818.       if(ioctl(fileno(info->fp),FIONREAD,&chars))chars=0;
  2819. #ifndef NO_CNT
  2820.       chars+=(info->fp)->_cnt;  /* add the number of buffered chars */
  2821. #endif
  2822.       if(line && info->persist && (filepos=ftell(info->fp))>=0){
  2823.          lines=0;
  2824.      c2='\n';
  2825.          while((ch=getc(info->fp))!=EOF){ /* count lines */
  2826.         if(ch=='\n')lines++;
  2827.         c2=ch;
  2828.      }
  2829.      if(c2!='\n')lines++;
  2830.      fseek(info->fp,filepos,0);
  2831.       }
  2832.       else lines=(chars>0);
  2833.    }
  2834.    else { /* Not open.  Try to open it (to see whether we have access) */
  2835.           /* Funny thing is, we only make a fileinfo structure for it if
  2836.          there is an error (to hold the error number). */
  2837.       chars=lines=0;
  2838.       if(!(fp=fopen(name,"r"))){
  2839.          info=fileinit(name,name,fp);
  2840.      info->errno=errno+Eerrno;
  2841.          rcset(errno,Enotready,name);
  2842.       }
  2843.       else if(fstat(fileno(fp),&buf)){
  2844.          info=fileinit(name,name,fp);
  2845.          info->errno=errno+Eerrno;
  2846.      rcset(errno,Enotready,name);
  2847.      /* file is still open, but that's OK since its info is stored */
  2848.       }
  2849.       else if(!S_ISREG(buf.st_mode)){
  2850.          /* Not a regular file.  Sometimes we are allowed to fopen a directory,
  2851.         in which case EISDIR should be reported.  Otherwise, since we
  2852.         were allowed to open the file, assume it is a readable file with
  2853.         no characters (e.g. a tty) and do not report an error. */
  2854.          if(S_ISDIR(buf.st_mode)){
  2855.         fclose(fp);
  2856.         info=fileinit(name,cnull,(FILE *)0);
  2857.         info->errno=EISDIR+Eerrno;
  2858.         rcset(EISDIR,Enotready,name);
  2859.      }
  2860.      else fclose(fp);
  2861.       }
  2862.       else{
  2863.          chars=buf.st_size;
  2864.      if(line){    /* Count lines */
  2865.         c2='\n';
  2866.         while((ch=getc(fp))!=EOF){
  2867.            if(ch=='\n')lines++;
  2868.            c2=ch;
  2869.         }
  2870.         if(c2!='\n')lines++;
  2871.      }
  2872.      else lines=(chars>0);
  2873.      fclose(fp);
  2874.       }
  2875.    }
  2876.    if(line)stackint(lines);
  2877.    else stackint((int)chars); /* Ahem! */
  2878. }
  2879.  
  2880. void rxclose(argc)
  2881. int argc;
  2882. {
  2883.    char *name;
  2884.    int len;
  2885.    if(argc!=1)die(Ecall);
  2886.    name=delete(&len);
  2887.    if(memchr(name,0,len))die(Ecall);
  2888.    else name[len]=0;
  2889.    if(!len)die(Ecall);
  2890.    stackint(fileclose(name));
  2891. }
  2892.  
  2893. void rxpclose(argc)
  2894. int argc;
  2895. {
  2896.    char *name;
  2897.    int len;
  2898.    int rc;
  2899.    char *ptr;
  2900.    struct fileinfo *info;
  2901.    if(argc!=1)die(Ecall);
  2902.    name=delete(&len);
  2903.    if(memchr(name,0,len))die(Ecall);
  2904.    else name[len]=0;
  2905.    if(!len)die(Ecall);
  2906.    ptr=hashsearch(1,name,&len);
  2907.    if(len&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  2908.       if(info->fp)rc=pclose(info->fp);
  2909.       else rc=-1;
  2910.       if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  2911.       free((char*)info);
  2912.       ((hashent *)ptr)->value=0;
  2913.    }
  2914.    else rc=0;
  2915.    if(rc==-1)stack("-1",2);
  2916.    else stackint((char)(rc/256));
  2917. }
  2918.    
  2919. void rxfileno(argc)
  2920. int argc;
  2921. {
  2922.    char *name;
  2923.    int len;
  2924.    struct fileinfo *info;
  2925.    if(argc!=1)die(Ecall);
  2926.    name=delete(&len);
  2927.    if(memchr(name,0,len))die(Ecall);
  2928.    else name[len]=0;
  2929.    if(!len)die(Ecall);
  2930.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))
  2931.       stack("-1",2);
  2932.    else stackint(fileno(info->fp));
  2933. }
  2934.  
  2935. void rxftell(argc)
  2936. int argc;
  2937. {
  2938.    char *name;
  2939.    int len;
  2940.    struct fileinfo *info;
  2941.    if(argc!=1)die(Ecall);
  2942.    name=delete(&len);
  2943.    if(memchr(name,0,len))die(Ecall);
  2944.    else name[len]=0;
  2945.    if(!len)die(Ecall);
  2946.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))len=-1;
  2947.    else len=ftell(info->fp); /* Ahem! */
  2948.    if(len>=0)len++;
  2949.    stackint(len);
  2950. }
  2951.  
  2952. void rxstream(argc)
  2953. int argc;
  2954. {
  2955.    char *stream;
  2956.    char option='S';
  2957.    char *command=0;
  2958.    char *param;
  2959.    int comlen;
  2960.    int len;
  2961.    int exist;
  2962.    char *answer;
  2963.    struct fileinfo *info;
  2964.    if(argc==3){
  2965.       command=delete(&comlen);
  2966.       argc--;
  2967.       if(comlen<=0)die(Ecall);
  2968.    }
  2969.    if(argc==2){
  2970.       stream=delete(&len);
  2971.       argc--;
  2972.       if(len==0)die(Ecall);
  2973.       if(len>0)option=stream[0]&0xdf;
  2974.    }
  2975.    if(argc!=1)die(Ecall);
  2976.    stream=delete(&len);
  2977.    if(len<1)die(Ecall);
  2978.    if(memchr(stream,0,len))die(Ecall);
  2979.    stream[len]=0;
  2980.    info=(struct fileinfo *)hashget(1,stream,&exist);
  2981.    switch(option){
  2982.       case 'D': if(command)die(Ecall);
  2983.          if(!info)answer="Stream is not open";
  2984.      else if(!info->errno)answer="Ready";
  2985.      else answer=message(info->errno);
  2986.      stack(answer,strlen(answer));
  2987.      return;
  2988.       case 'S': if(command)die(Ecall);
  2989.          if(!info)stack("UNKNOWN",7);
  2990.      else if(!info->errno)stack("READY",5);
  2991.      else if(info->errno==Eeof+Eerrno || info->errno<Eerrno)
  2992.         stack("NOTREADY",8);
  2993.      else stack("ERROR",5);
  2994.      return;
  2995.       case 'C': break; /* out of the switch to do the work */
  2996.       default: die(Ecall);
  2997.    }
  2998.    if(!command)die(Ecall);
  2999.    param=command;
  3000.    while(comlen--&& *param++!=' ');    /* Find the command end */
  3001.    if(comlen>=0){
  3002.       param[-1]=0;                     /* terminate the command */
  3003.       while(comlen--&& *param++==' '); /* Find the parameter */
  3004.       comlen++,param--;
  3005.    }
  3006.    else param[0]=comlen=0;
  3007.    /***/if(!strcasecmp(command,"close")){ /* syntax: "close" */
  3008.       if(comlen)die(Ecall);
  3009.       stackint(fileclose(stream));
  3010.    }
  3011.    else if(!strcasecmp(command,"fdopen")){/* syntax: "fdopen [mode][,n]" */
  3012.       char *n;
  3013.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3014.       comlen-=len+1;
  3015.       for(n=param+len+1;comlen>0&&n[0]==' ';n++,comlen--);
  3016.       if(comlen<0)comlen=0;
  3017.       rxfdopen2(stream,param,len,n,comlen);
  3018.    }
  3019.    else if(!strcasecmp(command,"fileno")){/* syntax: "fileno" */
  3020.       if(info && info->fp)stackint(fileno(info->fp));
  3021.       else stack("-1",2);
  3022.    }
  3023.    else if(!strcasecmp(command,"flush")){ /* syntax: "flush" */
  3024.       if(info && info->fp)stackint(fflush(info->fp));
  3025.       else stack("-1",2);
  3026.    }
  3027.    else if(!strcasecmp(command,"ftell")){ /* syntax: "ftell" */
  3028.       if(info && info->fp)stackint(ftell(info->fp));
  3029.       else stack("-1",2);
  3030.    }
  3031.    else if(!strcasecmp(command,"open")){  /* syntax: "open [mode][,path]" */
  3032.       char *path;
  3033.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3034.       comlen-=len+1;
  3035.       for(path=param+len+1;comlen>0&&path[0]==' ';path++,comlen--);
  3036.       if(comlen<0)comlen=0;
  3037.       rxopen2(stream,param,len,path,comlen);
  3038.    }
  3039.    else if(!strcasecmp(command,"pclose")){/* syntax: "pclose" */
  3040.       char *ptr=hashsearch(1,stream,&exist);
  3041.       int rc;
  3042.       if(exist&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  3043.          if(info->fp)rc=pclose(info->fp);
  3044.      else rc=-1;
  3045.      if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  3046.      free((char*)info);
  3047.      ((hashent *)ptr)->value=0;
  3048.       }
  3049.       else rc=0;
  3050.       if(rc==-1)stack("-1",2);
  3051.       else stackint((char)(rc/256));
  3052.    }
  3053.    else if(!strcasecmp(command,"popen")){ /* syntax: "popen [mode][,command]"*/
  3054.       char *cmd;
  3055.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3056.       comlen-=len+1;
  3057.       for(cmd=param+len+1;comlen>0&&cmd[0]==' ';cmd++,comlen--);
  3058.       if(comlen<0)comlen=0;
  3059.       rxpopen2(stream,param,len,cmd,comlen);
  3060.    }
  3061.    else die(Ecall);
  3062. }
  3063.  
  3064. void rxcondition(argc)
  3065. int argc;
  3066. {
  3067.    char option='I';
  3068.    char *arg;
  3069.    int len;
  3070.    int which=sgstack[interplev].which;
  3071.    if(argc>1)die(Ecall);
  3072.    if(argc){
  3073.       arg=delete(&len);
  3074.       if(len<=0)die(Ecall);
  3075.       option=arg[0]&0xdf;
  3076.    }
  3077.    switch(option){
  3078.       case 'I': arg=sgstack[interplev].type==1?"SIGNAL":"CALL";  break;
  3079.       case 'C': arg=conditions[which];                           break;
  3080.       case 'D': for(len=interplev;len>=0 && !(arg=sgstack[len].data);len--);
  3081.                                                                  break;
  3082.       case 'S': arg=sgstack[interplev].delay  &(1<<which)? "DELAY":
  3083.                     sgstack[interplev].callon &(1<<which)? "ON":
  3084.             sgstack[interplev].bits   &(1<<which)? "ON":
  3085.             "OFF";                                       break;
  3086.       default: die(Ecall);
  3087.    }
  3088.    if(!sgstack[interplev].type)arg=0;
  3089.    if(!arg)stack("",0);
  3090.    else stack(arg,strlen(arg));
  3091. }
  3092.             
  3093.       
  3094.